<mdl.int>/secagc.mid.80

   1
   2 TITLE SECAGC MUDDLE GARBAGE COLLECTOR FOR MULTI SECTIONS
   3
   4 ;SYSTEM WIDE DEFINITIONS GO HERE
   5
   6 RELOCATABLE
   7 GCST==$.
   8 TOPGRO==111100
   9 BOTGRO==001100
  10 MFORK==400000
  11 .GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
  12 .GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG
  13 .GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT
  14 .GLOBAL PGROW,TPGROW,MAINPR,%SLEEP,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR
  15 .GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC
  16 .GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC
  17 .GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM
  18 .GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR
  19 .GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI
  20 .GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2
  21 .GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN
  22 .GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT
  23 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
  24
  25 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB
  26 .GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR
  27 .GLOBAL ISECGC,SECLEN,RSECLE
  28 .GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10
  29 .GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC
  30 .GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG
  31 .GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET
  32
  33 .GLOBAL INBLOT,RSLENG
  34
  35 NOPAGS==1       ; NUMBER OF WINDOWS
  36 EOFBIT==1000
  37 PDLBUF=100
  38 NTPMAX==20000   ; NORMAL MAX TP SIZE
  39 NTPGOO==4000    ; NORMAL GOOD TP
  40 ETPMAX==2000    ; TPMAX IN AN EMERGENCY (I.E. GC RECALL)
  41 ETPGOO==2000    ; GOOD TP IN EMERGENCY
  42
  43
  44 GCHN==0         ; CHANNEL FOR FUNNNY INFERIOR
  45 STATNO==19.     ; # OF STATISTICS FOR BLOAT-STAT
  46 STATGC==8.      ; # OF GC-STATISTICS FOR BLOAT-STAT
  47
  48
  49 LOC REALGC+RLENGC+RSLENG
  50 OFFS==AGCLD-$.
  51 OFFSET OFFS
  52
  53 .INSRT MUDDLE >
  54
  55 .INSRT STENEX >
  56
  57 PGSZ==9.
  58
  59 F==E+1                          ; THESE 3 ACS OFTEN USED FOR XBLT
  60 G==F+1
  61 FPTR==G+1
  62
  63 TYPNT==FPTR+1                   ; SPECIAL AC USAGE DURING GC
  64 EXTAC==TYPNT+1                  ; ALSO SPECIAL DURING GC
  65 LPVP==EXTAC+1                   ; SPECIAL FOR GC, HOLDS POINTER TO PROCESS
  66                                 ;  CHAIN
  67 .LIST.==400000
  68 .GLOBAL %FXUPS,%FXEND
  69 \f
  70
  71
  72 DEFINE DOMULT INS
  73         FOOIT   [INS]
  74 TERMIN
  75
  76 DEFINE FOOIT INS,\LCN
  77         LCN==.-OFFS
  78         INS
  79         RMT [
  80                 TBLADD LCN
  81                 ]
  82 TERMIN
  83
  84 RMT [%FXLIN==0
  85 ]
  86
  87 DEFINE TBLADD LCN,\FOO
  88         FOO==.-OFFS
  89         %FXLIN,,LCN
  90         %FXLIN==FOO
  91         %FXUPS==FOO
  92         TERMIN
  93
  94
  95 RMT [XBLT==123000,,%XXBLT
  96 ]
  97
  98 \f
  99
 100 ISECGC:
 101
 102 ;SET FLAG FOR INTERRUPT HANDLER
 103         SETZB   M,RCL           ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE
 104                                 ;       PNTR
 105         EXCH    P,GCPDL         ; IN CASE CURRENT PDL LOSES
 106         PUSH    P,B
 107         PUSH    P,A
 108         PUSH    P,C             ; SAVE C
 109
 110 ; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING
 111
 112         MOVE    A,NOWFRE
 113         ADD     A,GCSTOP        ; ADJUSTMENT TO KEEP FREE REAL
 114         SUB     A,FRETOP
 115         MOVEM   A,NOWFRE
 116         MOVE    A,NOWP          ; ADJUSTMENTS FOR STACKS
 117         SUB     A,CURP
 118         MOVEM   A,NOWP
 119         MOVE    A,NOWTP
 120         SUB     A,CURTP
 121         MOVEM   A,NOWTP
 122
 123         MOVEI   B,[ASCIZ /SGIN /]
 124         SKIPE   GCMONF          ; MONITORING
 125         PUSHJ   P,MSGTYP
 126 NOMON1: HRRZ    C,(P)           ; GET CAUSE OF GC INDICATOR
 127         MOVE    B,GCNO(C)       ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON
 128         ADDI    B,1
 129         MOVEM   B,GCNO(C)
 130         MOVEM   C,GCCAUS        ; SAVE CAUSE OF GC
 131         SKIPN   GCMONF          ; MONITORING
 132         JRST    NOMON2
 133         MOVE    B,MSGGCT(C)     ; GET CAUSE MESSAGE
 134         PUSHJ   P,MSGTYP
 135 NOMON2: HLRZ    C,(P)           ; FIND OUT WHO CAUSED THE GC
 136         MOVEM   C,GCCALL        ; SAVE CALLER OF GC
 137         SKIPN   GCMONF          ; MONITORING
 138         JRST    NOMON3
 139         MOVE    B,MSGGFT(C)
 140         PUSHJ   P,MSGTYP
 141 NOMON3: ADJSP   P,-1            ; POP OFF C
 142         POP     P,A
 143         POP     P,B
 144         EXCH    P,GCPDL
 145         HLLZS   SQUPNT          ; FLUSH SQUOZE TABLE
 146 INITGC: SETOM   GCFLG
 147         SETZM   RCLV
 148
 149 ;SAVE AC'S
 150         EXCH    PVP,PVSTOR+1
 151         IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
 152         MOVEM   AC,AC!STO"+1(PVP)
 153         TERMIN
 154
 155         MOVE    0,PVSTOR+1
 156         MOVEM   0,PVPSTO+1(PVP)
 157         MOVEM   PVP,PVSTOR+1
 158         MOVE    D,DSTORE
 159         MOVEM   D,DSTO(PVP)
 160         JSP     E,CKPUR         ; CHECK FOR PURE RSUBR
 161
 162 ;SET UP E TO POINT TO TYPE VECTOR
 163
 164         GETYP   E,TYPVEC
 165         CAIE    E,TVEC
 166         JRST    AGCE1
 167         HRRZ    TYPNT,TYPVEC+1
 168         HRLI    TYPNT,400000+B  ; LOCAL INDEX
 169
 170 CHPDL:  MOVE    D,P             ; SAVE FOR LATER
 171 CORGET: MOVE    P,[GCSEG,,MRKPDL]       ; USE GCSEG FOR PDL
 172
 173 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
 174
 175         HRRZ    A,TB            ;POINT TO CURRENT FRAME IN PROCESS
 176         PUSHJ   P,FRMUNG        ;AND MUNG IT
 177         MOVE    A,TP            ;THEN TEMPORARY PDL
 178         PUSHJ   P,PDLCHK
 179         MOVE    PVP,PVSTOR+1
 180         MOVE    A,PSTO+1(PVP)   ;AND UNMARKED P STACK
 181         PUSHJ   P,PDLCHP
 182
 183 \f; FIRST CREATE INFERIOR TO HOLD NEW PAGES
 184
 185 INFCRT: MOVE    A,PARBOT        ; GENERATE NEW PARBOT AND PARNEW
 186         ADD     A,PARNEW
 187         ADDI    A,1777
 188         ANDCMI  A,1777          ; EVEN PAGE BOUNDARY
 189         MOVEM   A,NPARBO
 190         MOVE    FPTR,A
 191         HRLI    FPTR,GCSEG
 192
 193 ; NOW ZERO OUT NEW SPACE USING XBLT
 194
 195 ;       DOMULT  [SETZM  (FPTR)]
 196 ;       MOVEI   0,777777-1
 197 ;       SUBI    0,(FPTR)        ; FROM VECBOT UP
 198 ;       MOVE    A,FPTR
 199 ;       MOVE    B,A
 200 ;       ADDI    B,1
 201 ;       DOMULT  [XBLT   0,]
 202
 203 ; USE PMAP TO FLUSH GC SPACE PAGES
 204
 205         MOVNI   A,1
 206         MOVE    B,[MFORK,,GCSEG_9.]
 207         MOVE    C,[SETZ 777]
 208         PMAP
 209
 210 ;MARK PHASE: MARK ALL LISTS AND VECTORS
 211 ;POINTED TO WITH ONE BIT IN SIGN BIT
 212 ;START AT TRANSFER VECTOR
 213 NOMAP:  MOVE    A,GLOBSP+1      ; GET GLOBSP TO SAVE
 214         MOVEM   A,GCGBSP
 215         MOVE    A,ASOVEC+1      ; ALSO SAVE FOR USE BY GC
 216         MOVEM   A,GCASOV
 217         MOVE    A,NODES+1       ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT
 218                                 ;       PHASE
 219         MOVEM   A,GCNOD
 220         MOVE    A,GLOTOP+1      ; GET GLOTOP FOR LOCR HACKS
 221         MOVEM   A,GLTOP
 222         MOVE    A,PURVEC+1      ; SAVE PURE VECTOR FOR GETPAG
 223         MOVEM   A,PURSVT
 224         MOVE    A,HASHTB+1
 225         MOVEM   A,GCHSHT
 226
 227         SETZ    LPVP,           ;CLEAR NUMBER OF PAIRS
 228         MOVE    0,NGCS          ; SEE IF NEED HAIR
 229         SOSGE   GCHAIR
 230         MOVEM   0,GCHAIR        ; RESUME COUNTING
 231         MOVSI   D,400000        ;SIGN BIT FOR MARKING
 232         MOVE    A,ASOVEC+1      ;MARK ASSOC. VECTOR NOW
 233         PUSHJ   P,PRMRK         ; PRE-MARK
 234         MOVE    A,GLOBSP+1
 235         PUSHJ   P,PRMRK
 236         MOVE    A,HASHTB+1
 237         PUSHJ   P,PRMRK
 238 OFFSET 0
 239
 240         MOVE    A,IMQUOTE THIS-PROCESS
 241
 242 OFFSET OFFS
 243
 244         MOVEM   A,GCATM
 245
 246 ; HAIR TO DO AUTO CHANNEL CLOSE
 247
 248         MOVEI   0,N.CHNS-1      ; NUMBER OF CHANNELS
 249         MOVEI   A,CHNL1 ; 1ST SLOT
 250
 251         SKIPE   1(A)            ; NOW A CHANNEL?
 252         SETZM   (A)             ; DON'T MARK AS CHANNELS
 253         ADDI    A,2
 254         SOJG    0,.-3
 255
 256         MOVEI   C,PVSTOR
 257         MOVEI   B,TPVP
 258         MOVE    A,PVSTOR+1      ; MARK MAIN PROCES EVEN IF SWAPPED OUT
 259         PUSHJ   P,MARK
 260         MOVEI   C,MAINPR-1
 261         MOVEI   B,TPVP
 262         MOVE    A,MAINPR        ; MARK MAIN PROCES EVEN IF SWAPPED OUT
 263         PUSHJ   P,MARK
 264         MOVEM   A,MAINPR        ; ADJUST PTR
 265
 266 ; ASSOCIATION AND VALUE FLUSHING PHASE
 267
 268         SKIPN   GCHAIR          ; ONLY IF HAIR
 269         PUSHJ   P,VALFLS
 270
 271         SKIPN   GCHAIR
 272         PUSHJ   P,ATCLEA        ; CLEAN UP ATOM TABLE
 273
 274         SKIPE   GCHAIR          ; IF NOT HAIR, DO CHANNELS NOW
 275         PUSHJ   P,CHNFLS
 276
 277         PUSHJ   P,ASSOUP        ; UPDATE AND MOVE ASSOCIATIONS
 278         PUSHJ   P,CHFIX         ; SEND OUT CHANNELS AND MARK LOSERS
 279         PUSHJ   P,STOGC         ; FIX UP FROZEN WORLD
 280         MOVE    P,GCPDL         ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS
 281
 282         MOVE    A,NPARBO        ; UPDATE GCSBOT
 283         MOVEM   A,GCSBOT
 284         MOVE    A,PURSVT
 285         PUSH    P,PURVEC+1
 286         MOVEM   A,PURVEC+1      ; RESTORE PURVEC
 287         PUSHJ   P,CORADJ        ; ADJUST CORE SIZE
 288         POP     P,PURVEC+1
 289
 290
 291
 292 \f
 293 ; MOVE NEW GC SPACE IN
 294
 295 NOMAP1: MOVE    A,P.TOP
 296         SUBI    A,1
 297         MOVE    C,PARBOT
 298         MOVE    B,C
 299         SUB     A,B
 300         HRLI    B,GCSEG
 301         DOMULT  [XBLT   A,]
 302
 303 \f
 304 ; NOW REHASH THE ASSOCIATIONS BASED ON VALUES
 305 GARZR1: PUSHJ   P,REHASH
 306
 307
 308 \f;RESTORE AC'S
 309 TRYCOX: SKIPN   GCMONF
 310         JRST    NOMONO
 311         MOVEI   B,[ASCIZ /GOUT /]
 312         PUSHJ   P,MSGTYP
 313 NOMONO: MOVE    PVP,PVSTOR+1
 314         IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
 315         MOVE    AC,AC!STO+1(PVP)
 316         TERMIN
 317         SKIPN   DSTORE
 318         SETZM   DSTO(PVP)
 319         MOVE    PVP,PVPSTO+1(PVP)
 320
 321 ; CLOSING ROUTINE FOR G-C
 322         PUSH    P,A             ; SAVE AC'C
 323         PUSH    P,B
 324         PUSH    P,C
 325         PUSH    P,D
 326
 327         MOVE    A,FRETOP        ; ADJUST BLOAT-STAT PARAMETERS
 328         SUB     A,GCSTOP
 329         ADDM    A,NOWFRE
 330         PUSHJ   P,GCSET         ; FIX UP BLOAT-STAT PARAMETERS
 331         MOVE    A,CURTP
 332         ADDM    A,NOWTP
 333         MOVE    A,CURP
 334         ADDM    A,NOWP
 335
 336         PUSHJ   P,CTIME
 337         FSBR    B,GCTIM         ; GET TIME ELAPSED
 338         MOVEM   B,GCTIM         ; SAVE ELAPSED TIME FOR INT-HANDLER
 339         SKIPN   GCMONF          ; SEE IF MONITORING
 340         JRST    GCCONT
 341         PUSHJ   P,FIXSEN        ; OUTPUT TIME
 342         MOVEI   A,15            ; OUTPUT C/R LINE-FEED
 343         PUSHJ   P,IMTYO
 344         MOVEI   A,12
 345         PUSHJ   P,IMTYO
 346 GCCONT: MOVE    C,[NTPGOO,,NTPMAX]      ; MAY FIX UP TP PARAMS TO ENCOURAGE
 347                                         ; SHRINKAGE FOR EXTRA ROOM
 348         SKIPE   GCDANG
 349         MOVE    C,[ETPGOO,,ETPMAX]
 350         HLRZM   C,TPGOOD
 351         HRRZM   C,TPMAX
 352         POP     P,D             ; RESTORE AC'C
 353         POP     P,C
 354         POP     P,B
 355         POP     P,A
 356         MOVE    A,GCDANG
 357         JUMPE   A,AGCWIN                ; IF ZERO THE GC WORKED
 358         SKIPN   GCHAIR          ; SEE IF HAIRY GC
 359         JRST    BTEST
 360 REAGCX: MOVEI   A,1             ; PREPARE FOR A HAIRY GC
 361         MOVEM   A,GCHAIR
 362         SETZM   GCDANG
 363         MOVE    C,[11,,10.]     ; REASON FOR GC
 364         JRST    ISECGC
 365
 366 BTEST:  SKIPE   INBLOT
 367         JRST    AGCWIN
 368         FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS
 369         JRST    REAGCX
 370
 371 AGCWIN: SETZM   PARNEW          ;CLEAR FOR NEXT AGC CALL
 372         SETZM   GETNUM          ;ALSO CLEAR THIS
 373         SETZM   INBLOT
 374         SETZM   GCFLG
 375
 376         SETZM   PGROW           ; CLEAR GROWTH
 377         SETZM   TPGROW
 378         SETOM   GCHAPN          ; INDICATE A GC HAS HAPPENED
 379         SETOM   GCHPN
 380         SETOM   INTFLG          ; AND REQUEST AN INTERRUPT
 381         SETZM   GCDOWN
 382         PUSHJ   P,RBLDM
 383         JUMPE   R,FINAGC
 384         JUMPN   M,FINAGC        ; IF M 0, RUNNING RSUBR SWAPPED OUT
 385         SKIPE   PLODR           ; IF LOADING ONE, IT MIGHT NOT HAVE ARRIVED
 386          JRST   FINAGC
 387
 388         FATAL AGC--RUNNING RSUBR WENT AWAY
 389
 390 AGCE1:  FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR
 391
 392 \f; CORE ADJUSTMENT PHASE
 393
 394 CORADJ: MOVE    A,PURTOP
 395         SUB     A,CURPLN        ; ADJUST FOR RSUBR
 396         MOVEM   A,RPTOP
 397         HRRZ    A,FPTR          ; NEW GCSTOP
 398         ADDI    A,1777          ; GCPDL AND ROUND
 399         ANDCMI  A,1777          ; TO PAGE BOUNDRY
 400         MOVEM   A,CORTOP        ; TAKE CARE OF POSSIBLE LATER LOSSAGE
 401         CAMLE   A,RPTOP         ; SEE IF WE CAN MAP THE WORLD BACK IN
 402         FATAL   AGC--UNABLE TO MAP GC-SPACE INTO CORE
 403         CAMG    A,PURBOT        ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT
 404         JRST    CORAD0          ; DON'T HAVE TO PUNT SOME PURE
 405         PUSHJ   P,MAPOUT        ; GET THE CORE
 406         FATAL   AGC--PAGES NOT AVAILABLE
 407
 408 ; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS
 409 ; FIRST LETS SEE IF WE HAVE TO CORE DOWN.
 410 ; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED
 411
 412 CORAD0: SKIPN   B,GCDOWN        ; CORE DOWN?
 413         JRST    CORAD1          ; NO, LETS GET CORE REQUIREMENTS
 414         ADDI    A,(B)           ; AMOUNT+ONE FREE BLOCK
 415         CAMGE   A,RPTOP         ; CAN WE WIN
 416         JRST    CORAD3          ; POSSIBLY
 417
 418 ; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR
 419 CORAD2: SETOM   GCDANG          ; INDICATE LOSSAGE
 420
 421 ; CALCULATE PARAMETERS BEFORE LEAVING
 422 CORAD6: MOVE    A,PURSVT        ; GET PURE TABLE
 423         PUSHJ   P,SPCOUT        ; OUT IT GOES IN CASE IT WAS CHANGED
 424         HRRZ    A,FPTR          ; GCSTOP
 425         MOVEM   A,GCSTOP
 426         MOVE    A,CORTOP        ; ADJUST CORE IMAGE
 427         ASH     A,-10.          ; TO PAGES
 428 TRYPCO: PUSHJ   P,P.CORE
 429         FATAL NO CORE?
 430         MOVE    A,CORTOP        ; GET IT BACK
 431         ANDCMI  A,1777
 432         MOVEM   A,FRETOP
 433         MOVEM   A,RFRETP
 434         POPJ    P,
 435
 436
 437 ; TRIES TO SATISFY REQUEST FOR CORE
 438 CORAD1: MOVEM   A,CORTOP
 439         HRRZ    A,FPTR
 440         ADD     A,GETNUM        ; ADD MINIMUM CORE NEEDED
 441         ADDI    A,1777          ; ONE BLOCK+ROUND
 442         ANDCMI  A,1777          ; TO BLOCK BOUNDRY
 443         CAMLE   A,RPTOP         ; CAN WE WIN
 444         JRST    CORAD2          ; LOSE
 445         CAMGE   A,PURBOT
 446         JRST    CORAD7          ; DON'T HAVE TO MAP OUT PURE
 447         PUSHJ   P,MAPOUT
 448         JRST    CORAD2          ; LOSS
 449
 450 ; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE
 451 CORAD7: MOVEM   A,CORTOP        ; STORE POSSIBLE VALUE
 452         MOVE    B,RPTOP         ; GET REAL PURTOP
 453         SUB     B,PURMIN        ; KEEP PURMIN
 454         CAMG    B,CORTOP        ; SEE IF CORTOP IS ALREADY HIGH
 455         MOVE    B,CORTOP                ; DONT GIVE BACK WHAT WE GOT
 456         MOVEM   B,RPTOP         ; FOOL CORE HACKING
 457         ADD     A,FREMIN
 458         ANDCMI  A,1777          ; TO PAGE BOUNDRY
 459         CAMGE   A,RPTOP         ; DO WE WIN TOTALLY
 460         JRST    CORAD4
 461         MOVE    A,RPTOP         ; GET AS MUCH CORE AS POSSIBLE
 462         PUSHJ   P,MAPOUT
 463         JRST    CORAD6          ; LOSE, BUT YOU CAN'T HAVE EVERYTHING
 464 CORAD4: CAMG    A,PURBOT        ; DO WE HAVE TO PUNT SOME PURE
 465         JRST    CORAD8
 466         PUSHJ   P,MAPOUT        ; GET IT
 467         JRST    CORAD6
 468         MOVEM   A,CORTOP        ; ADJUST PARAMETER
 469         JRST    CORAD6          ; WIN TOTALLY
 470 CORAD8: MOVEM   A,CORTOP        ; NEW CORTOP
 471         JRST    CORAD6
 472
 473 ; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE
 474
 475 CORAD3: ADD     A,FREMIN
 476         ANDCMI  A,1777
 477         CAMGE   A,PURBOT        ; CAN WE WIN
 478         JRST    CORAD9
 479         MOVE    A,RPTOP
 480 CORAD9: SUB     A,GCDOWN        ; SATISFY GCDOWN REQUEST
 481         JRST    CORAD4          ; GO CHECK ALLOCATION
 482
 483 MAPOUT: PUSH    P,A             ; SAVE A
 484         SUB     A,P.TOP         ; AMOUNT TO GET
 485         ADDI    A,1777          ; ROUND
 486         ANDCMI  A,1777          ; TO PAGE BOUNDRY
 487         ASH     A,-PGSZ         ; TO PAGES
 488         PUSHJ   P,GETPAG        ; GET THEN
 489         JRST    MAPLOS          ; LOSSAGE
 490         AOS     -1(P)           ; INDICATE WINNAGE
 491 MAPLOS: POP     P,A
 492         POPJ    P,
 493
 494
 495
 496 \f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
 497 ; POINT.
 498
 499 FIXSEN: PUSH    P,B             ; SAVE TIME
 500         MOVEI   B,[ASCIZ /TIME= /]
 501         PUSHJ   P,MSGTYP        ; PRINT OUT MESSAGE
 502         POP     P,B             ; RESTORE B
 503         FMPRI   B,(100.0)       ; CONVERT TO FIX
 504         MULI    B,400
 505         TSC     B,B
 506         ASH     C,-163.(B)
 507         MOVEI   A,1             ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
 508         PUSH    P,C
 509         IDIVI   C,10.           ; START COUNTING
 510         JUMPLE  C,.+2
 511         AOJA    A,.-2
 512         POP     P,C
 513         CAIN    A,1             ; SEE IF THERE IS ONLY ONE CHARACTER
 514         JRST    DOT1
 515 FIXOUT: IDIVI   C,10.           ; RECOVER NUMBER
 516         HRLM    D,(P)
 517         SKIPE   C
 518         PUSHJ   P,FIXOUT
 519         PUSH    P,A             ; SAVE A
 520         CAIN    A,2             ; DECIMAL POINT HERE?
 521         JRST    DOT2
 522 FIX1:   HLRZ    A,(P)-1         ; GET NUMBER
 523         ADDI    A,60            ; MAKE IT A CHARACTER
 524         PUSHJ   P,IMTYO         ; OUT IT GOES
 525         MOVEI   A,FSEG
 526         HRLM    A,-1(P)
 527         POP     P,A
 528         SOJ     A,
 529         POPJ    P,
 530 DOT1:   MOVEI   A,".            ; OUTPUT DECIMAL POINT AND PADDING 0
 531         PUSHJ   P,IMTYO
 532         MOVEI   A,"0
 533         PUSHJ   P,IMTYO
 534         JRST    FIXOUT          ; CONTINUE
 535 DOT2:   MOVEI   A,".            ; OUTPUT DECIMAL POINT
 536         PUSHJ   P,IMTYO
 537         JRST    FIX1
 538
 539
 540 \f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
 541
 542 PDLCHK: JUMPGE  A,CPOPJ
 543         HLRE    B,A             ;GET NEGATIVE COUNT
 544         MOVE    C,A             ;SAVE A COPY OF PDL POINTER
 545         SUBI    A,-1(B)         ;LOCATE DOPE WORD PAIR
 546         HRRZS   A               ; ISOLATE POINTER
 547         CAME    A,TPGROW        ;GROWING?
 548         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
 549         MOVMS   B
 550         CAIN    A,2(C)
 551         JRST    NOFENC
 552         SETOM   1(C)            ; START FENECE POST
 553         CAIN    A,3(C)
 554         JRST    NOFENC
 555         MOVSI   D,1(C)          ;YES, SET UP TO BLT FENCE POSTS
 556         HRRI    D,2(C)
 557         BLT     D,-2(A)         ;FENCE POST ALL EXCEPT DOPE WORDS
 558
 559
 560 NOFENC: CAMG    B,TPMAX         ;NOW CHECK SIZE
 561         CAMG    B,TPMIN
 562         JRST    MUNGTP          ;TOO BIG OR TOO SMALL
 563         POPJ    P,
 564
 565 MUNGTP: SUB     B,TPGOOD        ;FIND DELTA TP
 566 MUNG3:  MOVE    C,-1(A)         ;IS GROWTH ALREADY SPECIFIED
 567         TRNE    C,777000        ;SKIP IF NOT
 568         POPJ    P,              ;ASSUME GROWTH GIVEN WILL WIN
 569
 570         ASH     B,-6            ;CONVERT TO NUMBER OF BLOCKS
 571         JUMPLE  B,MUNGT1
 572         CAILE   B,377           ; SKIP IF BELOW MAX
 573         MOVEI   B,377           ; ELSE USE MAX
 574         TRO     B,400           ;TURN ON SHRINK BIT
 575         JRST    MUNGT2
 576 MUNGT1: MOVMS   B
 577         ANDI    B,377
 578 MUNGT2: DPB     B,[TOPGRO,,-1(A)]       ;STORE IN DOPE WORD
 579         POPJ    P,
 580
 581 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
 582
 583 PDLCHP: HLRE    B,A             ;-LENGTH TO B
 584         MOVE    C,A
 585         SUBI    A,-1(B)         ;POINT TO DOPE WORD
 586         HRRZS   A               ;ISOLATE POINTER
 587         CAME    A,PGROW         ;GROWING?
 588         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
 589         MOVMS   B
 590         CAIN    A,2(C)
 591         JRST    NOPF
 592         SETOM   1(C)            ; START FENECE POST
 593         CAIN    A,3(C)
 594         JRST    NOPF
 595         MOVSI   D,1(C)
 596         HRRI    D,2(C)
 597         BLT     D,-2(A)
 598
 599 NOPF:   CAMG    B,PMAX          ;TOO BIG?
 600         CAMG    B,PMIN          ;OR TOO LITTLE
 601         JRST    .+2             ;YES, MUNG IT
 602         POPJ    P,
 603         SUB     B,PGOOD
 604         JRST    MUNG3
 605
 606
 607 ; ROUTINE TO PRE MARK SPECIAL HACKS
 608
 609 PRMRK:  SKIPE   GCHAIR          ; FLUSH IF NO HAIR
 610         POPJ    P,
 611 PRMRK2: HLRE    B,A
 612         SUBI    A,(B)           ;POINT TO DOPE WORD
 613         HLRZ    EXTAC,1(A)      ; GET LNTH
 614         LDB     0,[TOPGRO,,(A)] ; GET GROWTHS
 615         TRZE    0,400           ; SIGN HACK
 616         MOVNS   0
 617         ASH     0,6             ; TO WORDS
 618         ADD     EXTAC,0
 619         LDB     0,[BOTGRO,,(A)]
 620         TRZE    0,400
 621         MOVNS   0
 622         ASH     0,6
 623         ADD     EXTAC,0
 624         PUSHJ   P,ALLOGC
 625         HRRM    0,1(A)          ; NEW RELOCATION FIELD
 626         IORM    D,1(A)          ;AND MARK
 627         POPJ    P,
 628
 629
 630 \f;GENERAL MARK SUBROUTINE.  CALLED TO MARK ALL THINGS
 631 ; A/ GOODIE TO MARK FROM
 632 ; B/ TYPE OF A (IN RH)
 633 ; C/ TYPE,DATUM PAIR POINTER
 634
 635 MARK2A:
 636 MARK2:  HLRZ    B,(C)           ;GET TYPE
 637 MARK1:  MOVE    A,1(C)          ;GET GOODIE
 638 MARK:   JUMPE   A,CPOPJ         ; NEVER MARK 0
 639         MOVEI   0,1(A)
 640         CAML    0,PURBOT
 641         JRST    GCRETD
 642 MARCON: PUSH    P,C
 643         PUSH    P,A
 644         ANDI    B,TYPMSK        ; FLUSH MONITORS
 645         LSH     B,1             ;TIMES 2 TO GET SAT
 646         HRRZ    B,@TYPNT        ;GET SAT
 647         ANDI    B,SATMSK
 648         JUMPE   A,GCRET
 649         CAILE   B,NUMSAT        ; SKIP IF TEMPLATE DATA
 650         JRST    TD.MRK
 651         JRST    @SMKTBS(B)
 652
 653 SMKTBS:
 654
 655 OFFSET 0
 656
 657 TBLDIS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
 658 [STPSTK,TPMK],[SARGS,ARGMK],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
 659 [SFRAME,FRMK],[SBYTE,BYTMK],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
 660 [SLOCID,LOCMK],[SCHSTR,BYTMK],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
 661 [SLOCA,ARGMK],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,BYTMK],[SLOCN,ASMRK]
 662 [SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,BYTMK],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]NUMSAT,400000
 663
 664 OFFSET OFFS
 665
 666 ; HERE TO MARK A POSSIBLE DEFER POINTER
 667
 668 DEFQMK: GETYP   B,(A)           ; GET ITS TYPE
 669         LSH     B,1
 670         HRRZ    B,@TYPNT
 671         ANDI    B,SATMSK        ; AND TO SAT
 672         SKIPGE  MKTBS(B)
 673
 674 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
 675
 676 DEFMK:  SETOM   GENFLG          ; SET FLAG SAYING DEFERRED
 677         CAIA
 678
 679 ;HERE TO MARK LIST ELEMENTS
 680
 681 PAIRMK: SETZM   GENFLG          ;TURN OF DEFER BIT
 682         PUSH    P,[0]           ; WILL HOLD BACK PNTR
 683         MOVEI   C,(A)           ; POINT TO LIST
 684 PAIRM1: CAMGE   C,PARTOP        ;CHECK FOR BEING IN BOUNDS
 685         CAMGE   C,PARBOT
 686         FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE
 687         SKIPGE  B,(C)           ;SKIP IF NOT MARKED
 688         JRST    RETNEW          ;ALREADY MARKED, RETURN
 689         IORM    D,(C)           ;MARK IT
 690         DOMULT  [MOVEM  B,(FPTR)]
 691         MOVE    0,1(C)          ; AND 2D
 692         DOMULT  [MOVEM  0,1(FPTR)]
 693         ADDI    FPTR,2          ; MOVE ALONG IN NEW SPACE
 694
 695 PAIRM2: MOVEI   A,-2(FPTR)      ; GET INF ADDR
 696         HRRM    A,(C)           ; LEAVE A POINTER TO NEW HOME
 697         HRRZ    E,(P)           ; GET BACK POINTER
 698         JUMPE   E,PAIRM7        ; 1ST ONE, NEW FIXUP
 699         HRLI    E,GCSEG
 700         DOMULT  [HRRM   A,(E)]          ; CLOBBER
 701 PAIRM4: MOVEM   A,(P)           ; NEW BACK POINTER
 702         SKIPGE  GENFLG
 703          JRST   DEFDO   ;GO HANDLE DEFERRED POINTER
 704         HRLM    B,(P)           ; SAVE OLD CDR
 705         PUSHJ   P,MARK2         ;MARK THIS DATUM
 706         HRRZ    E,(P)           ; SMASH CAR IN CASE CHANGED
 707         HRLI    E,GCSEG
 708         DOMULT  [MOVEM  A,1(E)]
 709         HLRZ    C,(P)           ;GET CDR OF LIST
 710         CAIGE   C,@PURBOT       ; SKIP IF PURE (I.E. DONT MARK)
 711         JUMPN   C,PAIRM1        ;IF NOT NIL, MARK IT
 712 GCRETP: ADJSP   P,-1
 713
 714 GCRET:  SETZM   GENFLG  ;FOR PAIRMKS BENEFIT
 715         POP     P,A             ;RESTORE C AND A
 716         POP     P,C
 717         POPJ    P,              ;AND RETURN TO CALLER
 718
 719 GCRETD: ANDI    B,TYPMSK        ; TURN OFF MONITORS
 720         CAIN    B,TLOCR         ; SEE IF A LOCR
 721         JRST    MARCON
 722         POPJ    P,
 723
 724 ;HERE TO MARK DEFERRED POINTER
 725
 726 DEFDO:  PUSH    P,B             ; PUSH OLD PAIR ON STACK
 727         PUSH    P,1(C)
 728         MOVEI   C,-1(P)         ; USE AS NEW DATUM
 729         HRLI    C,GCSEG         ; KEEP IN CORRECT SECTION
 730         PUSHJ   P,MARK2         ;MARK THE DATUM
 731         HRRZ    E,-2(P)         ; GET POINTER IN INF CORE
 732         HRLI    E,GCSEG
 733         DOMULT  [MOVEM  A,1(E)]
 734         MOVE    A,-1(P)
 735         DOMULT  [HRRM   A,(E)]
 736         ADJSP   P,-3
 737         JRST    GCRET           ;AND RETURN
 738
 739
 740 PAIRM7: MOVEM   A,-1(P)         ; SAVE NEW VAL FOR RETURN
 741         JRST    PAIRM4
 742
 743 RETNEW: HRRZ    A,(C)           ; POINT TO NEW WORLD LOCN
 744         HRRZ    E,(P)           ; BACK POINTER
 745         JUMPE   E,RETNW1        ; NONE
 746         HRLI    E,GCSEG
 747         DOMULT  [HRRM   A,(E)]
 748         JRST    GCRETP
 749
 750 RETNW1: MOVEM   A,-1(P)
 751         JRST    GCRETP
 752
 753
 754 \f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
 755
 756 TPMK:   SETOM   GENFLG          ;SET TP MARK FLAG
 757         CAIA
 758 VECTMK: SETZM   GENFLG
 759         PUSH    P,FPTR
 760         MOVEI   E,(A)           ;SAVE A POINTER TO THE VECTOR
 761         HLRE    B,A             ;GET -LNTH
 762         SUB     A,B             ;LOCATE DOPE WORD
 763         MOVEI   A,1(A)          ;ZERO LH AND POINT TO 2ND DOPE WORD
 764         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
 765         CAMLE   A,GCSTOP
 766         JRST    VECTB1          ;LOSE, COMPLAIN
 767
 768         MOVE    0,GENFLG
 769         HLLM    0,(P)           ; SAVE TP VS VECT INDICATOR
 770         JUMPE   0,NOBUFR        ;IF A VECTOR, NO BUFFER CHECK
 771         CAME    A,PGROW         ;IS THIS THE BLOWN P
 772         CAMN    A,TPGROW        ;IS THIS THE GROWING PDL
 773         JRST    NOBUFR          ;YES, DONT ADD BUFFER
 774         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
 775         MOVSI   0,-PDLBUF       ;ALSO FIX UP POINTER
 776         ADD     0,1(C)
 777         MOVEM   0,-1(P)         ; FIXUP RET'D PNTR
 778
 779 NOBUFR: HLRE    B,(A)           ;GET LENGTH FROM DOPE WORD
 780         JUMPL   B,EXVECT        ; MARKED, LEAVE
 781         LDB     B,[TOPGRO,,-1(A)]       ; GET TOP GROWTH
 782         TRZE    B,400           ; HACK SIGN BIT
 783         MOVNS   B
 784         ASH     B,6             ; CONVERT TO WORDS
 785         PUSH    P,B             ; SAVE TOP GROWTH
 786         LDB     0,[BOTGRO,,-1(A)]       ;GET GROWTH FACTOR
 787         TRZE    0,400           ;KILL SIGN BIT AND SKIP IF +
 788         MOVNS   0               ;NEGATE
 789         ASH     0,6             ;CONVERT TO NUMBER OF WORDS
 790         PUSH    P,0             ; SAVE BOTTOM GROWTH
 791         ADD     B,0             ;TOTAL GROWTH TO B
 792 VECOK:  HLRE    E,(A)           ;GET LENGTH AND MARKING
 793         MOVEI   EXTAC,(E)               ;SAVE A COPY
 794         ADD     EXTAC,B         ;ADD GROWTH
 795         SUBI    E,2             ;- DOPE WORD LENGTH
 796         IORM    D,(A)           ;MAKE SURE NOW MARKED
 797         PUSHJ   P,ALLOGC        ; ALLOCATE SPACE FOR VECTOR IN THE INF
 798         HRRM    0,(A)
 799 VECOK1: JUMPLE  E,MOVEC2        ; ZERO LENGTH, LEAVE
 800         PUSH    P,A             ; SAVE POINTER TO DOPE WORD
 801         MOVE    EXTAC,GENFLG
 802         SKIPGE  B,-1(A)         ;SKIP IF UNIFORM
 803         TLNE    B,377777-.VECT. ;SKIP IF NOT SPECIAL
 804         JUMPE   EXTAC,NOTGEN    ;JUMP IF NOT A GENERAL VECTOR
 805
 806 GENRAL: HLRZ    0,B             ;CHECK FOR PSTACK
 807         TRZ     0,.VECT.
 808         JUMPE   0,NOTGEN        ;IT ISN'T GENERAL
 809         JUMPN   EXTAC,TPMK1     ; JUMP IF TP
 810         MOVEI   C,(A)
 811         SUBI    C,1(E)          ; C POINTS TO BEGINNING OF VECTOR
 812
 813 \f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR
 814 VECTM2: HLRE    B,(C)           ;GET TYPE AND MARKING
 815         JUMPL   B,UMOVEC        ;RETURN, (EITHER DOPE WORD OR FENCE POST)
 816         MOVE    A,1(C)          ;DATUM TO A
 817
 818
 819 VECTM3: PUSHJ   P,MARK          ;MARK DATUM
 820         MOVEM   A,1(C)          ; IN CASE WAS FIXED
 821 VECTM4: ADDI    C,2
 822         JRST    VECTM2
 823
 824 UMOVEC: POP     P,A
 825 MOVEC2: POP     P,C             ; RESTORE BOTTOM GROWTH
 826         CAMGE   A,GCSBOT        ; DONT DO THIS STUFF IF THIS IS FROZEN
 827         JRST    EXVEC1
 828         HRRZ    B,-1(P)         ; GET POINTER INTO INF
 829         JUMPLE  C,MOVEC3
 830         ADD     B,C             ; GROW IT
 831 MOVEC3: HLLZ    0,-1(A)         ; MODIFY DOPE WORD AND PLACE IN INF
 832         TLO     0,.VECT.
 833         HRRZ    EXTAC,(A)       ; DESTINATION OF DOPEWORDS (SORT OF)
 834         HRLI    EXTAC,GCSEG     ; MAKE INTO CORRECT KIND OF ADDR
 835         DOMULT  [MOVEM  0,-1(EXTAC)]
 836         HLRZ    0,(A)
 837         ANDI    0,377777        ; KILL MARK BIT
 838         SKIPG   C
 839         ADD     0,C             ; COMPENSATE FOR SHRINKAGE
 840         MOVE    EXTAC,A
 841         SUB     A,0
 842         ADDI    A,1
 843         SKIPGE  (P)             ; ACCOUNT FOR OTHER END SHRINKAGE
 844         ADD     0,(P)
 845         HRLI    B,GCSEG
 846         SUBI    0,2             ; AVOID RE-SENDING DOPE WORDS
 847         DOMULT  [XBLT   0,]             ; MOVE VECTOR TO OTHER IMAGE
 848         MOVE    A,EXTAC
 849 EXVEC1: ADJSP   P,-1
 850
 851 EXVECT: HLRZ    B,(P)
 852         ADJSP   P,-1            ; GET RID OF FPTR
 853         PUSHJ   P,RELATE        ; RELATIVIZE
 854         JUMPE   B,GCRET
 855         MOVSI   0,PDLBUF        ; FIX UP STACK PTR
 856         ADDM    0,(P)
 857         JRST    GCRET           ; EXIT
 858
 859 VECLOS: JUMPL   C,CCRET         ;JUMP IF CAN'T MUNG TYPE
 860         HLLZ    0,(C)           ;GET TYPE
 861         MOVEI   B,TILLEG        ;GET ILLEGAL TYPE
 862         HRLM    B,(C)
 863         MOVEM   0,1(C)          ;AND STORE OLD TYPE AS VALUE
 864         JRST    UMOVEC          ;RETURN WITHOUT MARKING VECTOR
 865
 866 CCRET:  CLEARM  1(C)            ;CLOBBER THE DATUM
 867         JRST    GCRET
 868
 869 \f
 870 ; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN
 871 ; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL.
 872
 873 TPMK1:
 874 TPMK2:  POP     P,A             ; RESTORE DW POINTER
 875         POP     P,C             ; AND BOTTOM GROWTH
 876         HRRZ    E,-1(P)         ; FIX UP PARAMS
 877         ADDI    E,(C)
 878         PUSH    P,A             ; REPUSH A
 879         HRRZ    B,(A)           ; CALCULATE RELOCATION
 880         SUB     B,A
 881         MOVE    C,-1(P)         ; ADJUST FOR GROWTH
 882         SUB     B,C
 883         HRLZS   C
 884         HRLI    E,GCSEG
 885         PUSH    P,C
 886         PUSH    P,B
 887         PUSH    P,E
 888         PUSH    P,[0]
 889 TPMK3:  HLRZ    E,(A)           ; GET LENGTH
 890         TRZ     E,400000        ; GET RID OF MARK BIT
 891         SUBI    A,-1(E)         ;POINT TO FIRST ELEMENT
 892         MOVEI   C,(A)           ;POINT TO FIRST ELEMENT WITH C
 893 TPMK4:  HLRE    B,(C)           ;GET TYPE AND MARKING
 894         JUMPL   B,TPMK7         ;RETURN, (EITHER DOPE WORD OR FENCE POST)
 895         HRRZ    A,(C)           ;DATUM TO A
 896         ANDI    B,TYPMSK        ; FLUSH MONITORS
 897         CAIE    B,TCBLK
 898         CAIN    B,TENTRY        ;IS THIS A STACK FRAME
 899         JRST    MFRAME          ;YES, MARK IT
 900         CAIE    B,TUBIND                ; BIND
 901         CAIN    B,TBIND         ;OR A BINDING BLOCK
 902         JRST    MBIND
 903         CAIE    B,TBVL          ; CHECK FOR OTHER BINDING HACKS
 904         CAIN    B,TUNWIN
 905         SKIPA                   ; FIX UP SP-CHAIN
 906         CAIN    B,TSKIP         ; OTHER BINDING HACK
 907         PUSHJ   P,FIXBND
 908
 909 TPMK5:  PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
 910         HRRM    A,(C)           ; FIX UP IN CASE OF SP CHAIN
 911         PUSHJ   P,MARK1         ;MARK DATUM
 912         MOVE    R,A             ; SAVE A
 913         POP     P,M
 914         MOVE    A,(C)
 915         AOS     E,-1(P)         ; MOVE OUT TYPE
 916         DOMULT  [MOVEM  A,-1(E)]
 917         DOMULT  [MOVEM  R,(E)]
 918         AOS     -1(P)
 919         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
 920 TPMK6:  ADDI    C,2
 921         JRST    TPMK4
 922
 923 MFRAME: HRRZ    0,1(C)          ; SET UP RELITIVIZATION OF PTR TO PREVIOUS
 924                                 ;   FRAME
 925         HRROI   C,FRAMLN+FSAV-1(C)      ;POINT TO FUNCTION
 926         HRRZ    A,1(C)          ; GET IT
 927         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
 928         CAMLE   A,GCSTOP
 929         JRST    MFRAM1          ; IGNORE, NOT IN VECTOR SPACE
 930         HRL     A,(A)           ; GET LENGTH
 931         MOVEI   B,TVEC
 932         PUSHJ   P,MARK          ; AND MARK IT
 933 MFRAM1: HLL     A,1(C)
 934         MOVE    E,-1(P)
 935         DOMULT  [MOVEM  A,(E)]
 936         HRRZ    A,OTBSAV-FSAV+1(C)      ; POINT TO TB TO PREVIOUS FRAME
 937         SKIPE   A
 938         ADD     A,-2(P)         ; RELOCATE IF NOT 0
 939         HLL     A,2(C)
 940         DOMULT  [MOVEM  A,1(E)]
 941         MOVE    A,-2(P)         ; ADJUST AB SLOT
 942         ADD     A,ABSAV-FSAV+1(C)       ; POINT TO SAVED AB
 943         DOMULT  [MOVEM  A,2(E)]
 944         MOVE    A,-2(P)         ; ADJUST SP SLOT
 945         ADD     A,SPSAV-FSAV+1(C)       ;POINT TO SAVED SP
 946         SUB     A,-3(P)         ; ADJUSTMENT OF LENGTH IF GROWTH
 947         DOMULT  [MOVEM  A,3(E)]
 948         HRROI   C,PSAV-FSAV(C)  ;POINT TO SAVED P
 949         MOVEI   B,TPDL
 950         ADDI    E,FRAMLN        ; UPDATE OUT ADDR
 951         MOVEM   E,-1(P)
 952         PUSHJ   P,MARK1         ;AND MARK IT
 953         MOVE    E,-1(P)
 954         DOMULT  [MOVEM  A,-3(E)]        ; STORE UPDATED P
 955         HLRE    0,TPSAV-PSAV+1(C)
 956         MOVE    A,TPSAV-PSAV+1(C)
 957         SUB     A,0
 958         MOVEI   0,1(A)
 959         MOVE    A,TPSAV-PSAV+1(C)
 960         CAME    0,TPGROW        ; SEE IF BLOWN
 961         JRST    MFRAM9
 962         MOVSI   0,PDLBUF
 963         ADD     A,0
 964 MFRAM9: ADD     A,-2(P)
 965         SUB     A,-3(P)         ; ADJUST
 966         DOMULT  [MOVEM  A,-2(E)]        ; AND UPDATED TP
 967         MOVE    A,PCSAV-PSAV+1(C)
 968         DOMULT  [MOVEM  A,-1(E)]        ; DONT FORGET SAVED PC
 969         HRROI   C,-PSAV+1(C)    ; POINT PAST THE FRAME
 970         JRST    TPMK4           ;AND DO MORE MARKING
 971
 972 MBIND:  PUSHJ   P,FIXBND
 973         MOVEI   B,TATOM         ;FIRST MARK ATOM
 974         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL NOW
 975         SKIPE   (P)             ; PASSED MARKER, IF SO DONT SKIP
 976         JRST    MBIND2          ; GO MARK
 977         MOVE    A,1(C)          ; RESTORE A
 978         CAME    A,GCATM
 979         JRST    MBIND1          ; NOT IT, CONTINUE SKIPPING
 980         HRRM    LPVP,2(C)       ; SAVE IN RH OF TPVP,,0
 981         MOVE    0,-4(P)         ; RECOVER PTR TO DOPE WORD
 982         HRLM    0,2(C)          ; SAVE FOR MOVEMENT
 983         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
 984         PUSHJ   P,MARK1         ; MARK THE ATOM
 985         MOVEI   LPVP,(C)        ; POINT
 986         SETOM   (P)             ; INDICATE PASSAGE
 987 MBIND1: ADDI    C,6             ; SKIP BINDING
 988         MOVEI   0,6
 989         SKIPE   -1(P)           ; ONLY UPDATE IF SENDING OVER
 990         ADDM    0,-1(P)
 991         JRST    TPMK4
 992
 993 MBIND2: HLL     A,(C)
 994         AOS     E,-1(P)         ; FIX UP CHAIN
 995         DOMULT  [MOVEM  A,-1(E)]
 996         MOVEI   B,TATOM         ; RESTORE IN CASE SMASHED
 997         PUSHJ   P,MARK1         ; MARK ATOM
 998         AOS     E,-1(P)         ; SEND IT OUT
 999         DOMULT  [MOVEM  A,-1(E)]
1000         ADDI    C,2
1001         PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
1002         PUSHJ   P,MARK2         ;MARK DATUM
1003         MOVE    R,A             ; SAVE A
1004         POP     P,M
1005         MOVE    A,(C)
1006         AOS     E,-1(P)         ; SEND IT OUT
1007         DOMULT  [MOVEM  A,-1(E)]
1008         MOVE    A,R
1009         DOMULT  [MOVEM  A,(E)]          ; SEND OUT VALUE
1010         AOS     -1(P)
1011         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
1012         ADDI    C,2
1013         MOVEI   B,TLIST         ; POINT TO DECL SPECS
1014         HLRZ    A,(C)
1015         PUSHJ   P,MARK          ; AND MARK IT
1016         HRR     A,(C)           ; LIST FIX UP
1017         AOS     E,-1(P)         ; SEND IT OUT
1018         DOMULT  [MOVEM  A,-1(E)]
1019         SKIPL   A,1(C)          ; PREV LOC?
1020         JRST    NOTLCI
1021         MOVEI   B,TLOCI         ; NOW MARK LOCATIVE
1022         PUSHJ   P,MARK1
1023 NOTLCI: AOS     E,-1(P)         ; SEND IT OUT
1024         DOMULT  [MOVEM  A,-1(E)]
1025         ADDI    C,2
1026         JRST    TPMK4
1027
1028 FIXBND: HRRZ    A,(C)           ; GET PTR TO CHAIN
1029         SKIPE   A               ; DO NOTHING IF EMPTY
1030         ADD     A,-3(P)
1031         POPJ    P,
1032 TPMK7:
1033 TPMK8:  MOVNI   A,1             ; FENCE-POST THE STACK
1034         AOS     E,-1(P)         ; SEND IT OUT
1035         DOMULT  [MOVEM  A,-1(E)]
1036         ADDI    C,1             ; INCREMENT C FOR FENCE-POST
1037         ADJSP   P,-1            ; CLEAN UP STACK
1038         POP     P,E             ; GET UPDATED PTR TO INF
1039         ADJSP   P,-2    ; POP OFF RELOCATION
1040         HRRZ    A,(P)
1041         HLRZ    B,(A)
1042         TRZ     B,400000
1043         SUBI    A,-1(B)
1044         SUBI    C,(A)           ; GET # OF WORDS TRANSFERED
1045         SUB     B,C             ; GET # LEFT
1046         ADDI    E,-2(B)         ; ADJUST POINTER TO INF
1047         POP     P,A
1048         POP     P,C             ; IS THERE TOP GROWH
1049         ADD     E,C             ; MAKE ADJUSTMENT FOR TOP GROWTH
1050         ANDI    E,-1
1051         HLLZ    0,-1(A)         ; MODIFY DOPE WORD AND PLACE IN INF
1052         TLO     0,.VECT.
1053         HRRZ    EXTAC,(A)       ; DESTINATION OF DOPEWORDS (SORT OF)
1054         HRLI    EXTAC,GCSEG     ; MAKE INTO CORRECT KIND OF ADDR
1055         DOMULT  [MOVEM  0,-1(EXTAC)]
1056         JRST    EXVECT
1057 \f
1058 ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR
1059 ; EXTAC= # OF WORDS TO ALLOCATE
1060
1061 ALLOGC: HRRZS   A               ; GET ABS VALUE
1062         CAML    A,GCSBOT        ; SKIP IF IN STORAGE
1063         JRST    ALOGC2          ; JUMP IF ALLOCATING
1064         HRRZ    0,A
1065         POPJ    P,
1066 ALOGC2:
1067 ALOGC1: ADDI    FPTR,(EXTAC)
1068         MOVEI   0,-1(FPTR)
1069         DOMULT  [HRRM   0,-1(FPTR)]
1070         DOMULT  [HRLM   EXTAC,-1(FPTR)]
1071         POPJ    P,
1072
1073 \f; RELATE RELATAVIZES A POINTER TO A VECTOR
1074 ; B IS THE POINTER  A==> DOPE WORD
1075
1076 RELATE: CAMGE   A,GCSBOT        ; SEE IF IN VECTOR SPACE
1077         POPJ    P,              ; IF NOT EXIT
1078         MOVE    C,-1(P)
1079         HLRE    EXTAC,C         ; GET LENGTH
1080         HRRZ    0,-1(A)         ; CHECK FO GROWTH
1081         JUMPE   A,RELAT1
1082         LDB     0,[TOPGRO,,-1(A)]       ; GET TOP GROWTH
1083         TRZE    0,400           ; HACK SIGN BIT
1084         MOVNS   0
1085         ASH     0,6             ; CONVERT TO WORDS
1086         SUB     EXTAC,0         ; ACCOUNT FOR GROWTH
1087 RELAT1: HRLM    EXTAC,C         ; PLACE CORRECTED LENGTH BACK IN POINTER
1088         HRRZ    EXTAC,(A)       ; GET RELOCATED ADDR
1089         SUBI    EXTAC,(A)       ; FIND RELATIVIZATION AMOUNT
1090         ADD     C,EXTAC         ; ADJUST POINTER
1091         SUB     C,0             ; ACCOUNT FOR GROWTH
1092         MOVEM   C,-1(P)
1093         POPJ    P,
1094
1095
1096 \f; MARK TB POINTERS
1097 TBMK:   HRRZS   A               ; CHECK FOR NIL POINTER
1098         SKIPN   A
1099         JRST    GCRET           ; IF POINTING TO NIL THEN RETURN
1100         HLRE    B,TPSAV(A)      ; MAKE POINTER LOOK LIKE A TP POINTER
1101         HRRZ    C,TPSAV(A)              ; GET TO DOPE WORD
1102 TBMK2:  SUB     C,B             ; POINT TO FIRST DOPE WORD
1103         HRRZ    A,(P)           ; GET PTR TO FRAME
1104         SUB     A,C             ; GET PTR TO FRAME
1105         HRLS    A
1106         HRR     A,(P)
1107         MOVE    C,P
1108         PUSH    P,A
1109         MOVEI   B,TTP
1110         PUSHJ   P,MARK
1111         ADJSP   P,-1
1112         HRRM    A,(P)
1113         JRST    GCRET
1114 ABMK:   HLRE    B,A             ; FIX UP TO GET TO FRAME
1115         SUB     A,B
1116         HLRE    B,FRAMLN+TPSAV(A)       ; FIX UP TO LOOK LIKE TP
1117         HRRZ    C,FRAMLN+TPSAV(A)
1118         JRST    TBMK2
1119
1120 \f
1121 ; MARK ARG POINTERS
1122
1123 ARGMK:  HRRZ    A,1(C)          ; GET POINTER
1124         HLRE    B,1(C)          ; AND LNTH
1125         SUB     A,B             ; POINT TO BASE
1126         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1127         CAMLE   A,GCSTOP
1128         JRST    ARGMK0
1129         HLRZ    0,(A)           ; GET TYPE
1130         ANDI    0,TYPMSK
1131         CAIN    0,TCBLK
1132         JRST    ARGMK1
1133         CAIE    0,TENTRY        ; IS NEXT A WINNER?
1134         CAIN    0,TINFO
1135         JRST    ARGMK1          ; YES, GO ON TO WIN CODE
1136
1137 ARGMK0: SETZB   A,1(C)          ; CLOBBER THE CELL
1138         SETZM   (P)             ; AND SAVED COPY
1139         JRST    GCRET
1140
1141 ARGMK1: MOVE    B,1(A)          ; ASSUME TTB
1142         ADDI    B,(A)           ; POINT TO FRAME
1143         CAIE    0,TINFO         ; IS IT?
1144         MOVEI   B,FRAMLN(A)     ; NO, USE OTHER GOODIE
1145         HLRZ    0,OTBSAV(B)     ; GET TIME
1146         HRRZ    A,(C)           ; AND FROM POINTER
1147         CAIE    0,(A)           ; SKIP IF WINNER
1148         JRST    ARGMK0
1149         MOVE    A,TPSAV(B)              ; GET A RELATAVIZED TP
1150         HRROI   C,TPSAV-1(B)
1151         MOVEI   B,TTP
1152         PUSHJ   P,MARK1
1153         SUB     A,1(C)          ; AMOUNT TO RELATAVIZE ARGS
1154         HRRZ    B,(P)
1155         ADD     B,A
1156         HRRM    B,(P)           ; PUT RELATAVIZED PTR BACK
1157         JRST    GCRET
1158
1159 \f
1160 ; MARK FRAME POINTERS
1161
1162 FRMK:   HLRZ    B,A             ; GET TIME FROM FRAME PTR
1163         HLRZ    EXTAC,OTBSAV(A) ; GET TIME FROM FRAME
1164         CAME    B,EXTAC         ; SEE IF EQUAL
1165         JRST    GCRET
1166         SUBI    C,1             ;PREPARE TO MARK PROCESS VECTOR
1167         HRRZ    A,1(C)          ;USE AS DATUM
1168         SUBI    A,1             ;FUDGE FOR VECTMK
1169         MOVEI   B,TPVP          ;IT IS A VECTRO
1170         PUSHJ   P,MARK          ;MARK IT
1171         ADDI    A,1             ; READJUST PTR
1172         HRRM    A,1(C)          ; FIX UP PROCESS SLOT
1173         MOVEI   C,1(C)          ; SET UP FOR TBMK
1174         HRRZ    A,(P)
1175         JRST    TBMK            ; MARK LIKE TB
1176
1177 \f
1178 ; MARK BYTE POINTER
1179
1180 BYTMK:  PUSHJ   P,BYTDOP        ; GET DOPE WORD IN A
1181         HLRZ    EXTAC,-1(A)             ; GET THE TYPE
1182         ANDI    EXTAC,SATMSK    ; FLUSH MONITOR BITS
1183         CAIN    EXTAC,SATOM             ; SEE IF ATOM
1184         JRST    ATMSET
1185         HLRE    EXTAC,(A)               ; GET MARKING
1186         JUMPL   EXTAC,BYTREL    ; JUMP IF MARKED
1187         HLRZ    EXTAC,(A)               ; GET LENGTH
1188         PUSHJ   P,ALLOGC        ; ALLOCATE FOR IT
1189         HRRM    0,(A)           ; SMASH  IT IN
1190         MOVE    B,0
1191         HLRZ    0,(A)
1192         SUBI    0,1             ; DONT RESEND DW
1193         SUBI    B,-1(EXTAC)     ; ADJUST INF POINTER
1194         MOVE    E,A
1195         SUBI    A,-1(EXTAC)
1196         HRLI    B,GCSEG
1197         DOMULT  [XBLT   0,]
1198         IORM    D,(E)
1199         MOVE    A,E
1200 BYTREL: HRRZ    E,(A)
1201         SUBI    E,(A)
1202         ADDM    E,(P)           ; RELATAVIZE
1203         JRST    GCRET
1204
1205 ATMSET: PUSH    P,A             ; SAVE A
1206         HLRZ    B,(A)           ; GET LENGTH
1207         TRZ     B,400000        ; GET RID OF MARK BIT
1208         MOVNI   B,-2(B)         ; GET LENGTH
1209         ADDI    A,-1(B)         ; CALCULATE POINTER
1210         HRLI    A,(B)
1211         MOVEI   B,TATOM         ; TYPE
1212         PUSHJ   P,MARK
1213         POP     P,A             ; RESTORE A
1214         JRST    BYTREL          ; TO BYTREL
1215 \f
1216
1217 ; MARK OFFSET
1218
1219 OFFSMK: HLRZS   A
1220         PUSH    P,$TLIST
1221         MOVE    C,P
1222         PUSH    P,A             ; PUSH LIST POINTER ON THE STACK
1223         PUSHJ   P,MARK2         ; MARK THE LIST
1224         HRLM    A,-2(P)         ; UPDATE POINTER IN OFFSET
1225         ADJSP   P,-2
1226         JRST    GCRET
1227 \f
1228
1229 ; MARK ATOMS IN GVAL STACK
1230
1231 GATOMK: HRRZ    B,(C)           ; POINT TO POSSIBLE GDECL
1232         JUMPE   B,ATOMK
1233         CAIN    B,-1
1234         JRST    ATOMK
1235         MOVEI   A,(B)           ; POINT TO DECL FOR MARK
1236         MOVEI   B,TLIST
1237         MOVEI   C,0
1238         PUSHJ   P,MARK
1239         MOVE    C,-1(P)         ; RESTORE HOME POINTER
1240         HRRM    A,(C)           ; CLOBBER UPDATED LIST IN
1241         MOVE    A,1(C)          ; RESTORE ATOM POINTER
1242
1243 ; MARK ATOMS
1244
1245 ATOMK:
1246         MOVEI   0,(FPTR)
1247         PUSH    P,0             ; SAVE POINTER TO INF
1248         SETOM   .ATOM.          ; SAY ATOM WAS MARKED
1249         MOVEI   C,1(A)
1250         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
1251         JRST    ATMRL1          ; ALREADY MARKED
1252         PUSH    P,A             ; SAVE DOPE WORD PTR FOR LATER
1253         HLRZ    C,(A)           ; FIND REAL ATOM PNTR
1254         SUBI    C,400001        ; KILL MARK BIT AND ADJUST
1255         HRLI    C,-1(C)
1256         SUBM    A,C             ; NOW TOP OF ATOM
1257 MRKOBL: MOVEI   B,TOBLS
1258         HRRZ    A,2(C)          ; IF > 0, NOT OBL
1259         CAMG    A,VECBOT
1260         JRST    .+3
1261         HRLI    A,-1
1262         PUSHJ   P,MARK          ; AND MARK IT
1263         HRRM    A,2(C)
1264         SKIPN   GCHAIR
1265         JRST    NOMKNX
1266         HLRZ    A,2(C)
1267         MOVEI   B,TATOM
1268         PUSHJ   P,MARK
1269         HRLM    A,2(C)
1270 NOMKNX: HLRZ    B,(C)           ; SEE IF UNBOUND
1271         TRZ     B,400000        ; TURN OFF MARK BIT
1272         SKIPE   B
1273         CAIN    B,TUNBOUND
1274         JRST    ATOMK1          ; IT IS UNBOUND
1275         HRRZ    0,(C)           ; SEE IF VECTOR OR TP POINTER
1276         MOVEI   B,TVEC          ; ASSUME VECTOR
1277         SKIPE   0
1278         MOVEI   B,TTP           ; ITS A LOCAL VALUE
1279         PUSHJ   P,MARK1         ; MARK IT
1280         MOVEM   A,1(C)          ; SMASH INTO SLOT
1281 ATOMK1: HRRZ    0,2(C)          ; CHECK IF NOT ON ANY OBLIST
1282         POP     P,B             ; RESTORE A
1283         POP     P,C             ; GET POINTER INTO INF
1284         MOVE    A,B
1285         SKIPN   GCHAIR
1286         JUMPN   0,ATMREL        ; ALWAYS SEND OUT ATOMS ON NO OBLIST
1287
1288 ; HERE WITH B POINT TO CURRENT DW AND C TO NEW DW, DO IT TO IT
1289
1290 ATMOVX: PUSHJ   P,XBLTR
1291 ATMREL: HRRZ    E,(A)           ; RELATAVIZE
1292         SUBI    E,(A)
1293         ADDM    E,(P)
1294         JRST    GCRET
1295 ATMRL1: ADJSP   P,-1            ; POP OFF STACK
1296         JRST    ATMREL
1297
1298 ; HERE TO MOVE STUFF TO OTHER SEGMENT
1299 ; B==> CURRENT DW, C==> START OF NEW OBJECT (A MUST SURVIVE)
1300 XBLTR:  CAMGE   B,GCSBOT
1301         POPJ    P,
1302         MOVE    EXTAC,A
1303         HRRZ    E,(B)           ; NEW DW LOC
1304         HRLI    E,GCSEG
1305         DOMULT  [HLRZ   A,(E)]
1306         SUBI    A,1
1307         SUBI    B,(A)
1308         HRLI    C,GCSEG
1309         DOMULT  [XBLT   A,]
1310         MOVE    A,EXTAC         ; BACK TO A
1311         POPJ    P,
1312 \f
1313 GETLNT: HLRE    B,A             ;GET -LNTH
1314         SUB     A,B             ;POINT TO 1ST DOPE WORD
1315         MOVEI   A,1(A)          ;POINT TO 2ND DOPE WORD
1316         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1317         CAMLE   A,GCSTOP
1318         JRST    VECTB1          ;BAD VECTOR, COMPLAIN
1319         HLRE    B,(A)           ;GET LENGTH AND MARKING
1320         IORM    D,(A)           ;MAKE SURE MARKED
1321         JUMPL   B,AMTKE
1322         MOVEI   EXTAC,(B)       ; AMOUNT TO ALLOCATE
1323         PUSHJ   P,ALLOGC        ;ALLOCATE ROOM
1324         HRRM    0,(A)           ; RELATIVIZE
1325 AMTK1:  AOS     (P)             ; A NON MARKED ITEM
1326 AMTKE:  POPJ    P,              ;AND RETURN
1327
1328 GCRET1: ADJSP   P,-1            ;FLUSH RETURN ADDRESS
1329         JRST    GCRET
1330
1331
1332 \f
1333 ; MARK NON-GENERAL VECTORS
1334
1335 NOTGEN: CAMN    B,[GENERAL+<SPVP,,0>]
1336         JRST    GENRAL          ;YES, MARK AS A VECTOR
1337         JUMPL   B,SPECLS        ; COMPLAIN IF A SPECIAL HACK
1338         SUBI    A,1(E)          ;POINT TO TOP OF A UNIFORM VECTOR
1339         HLRZS   B               ;ISOLATE TYPE
1340         ANDI    B,TYPMSK
1341         MOVE    EXTAC,B         ; AND COPY IT
1342         LSH     B,1             ;FIND OUT WHERE IT WILL GO
1343         HRRZ    B,@TYPNT        ;GET SAT IN B
1344         ANDI    B,SATMSK
1345         HRRZ    C,SMKTBS(B)     ;POINT TO MARK SR
1346         CAIN    C,GCRET         ;IF NOT A MARKED FROM GOODIE, IGNORE
1347         JRST    UMOVEC
1348         MOVEI   C,-1(A)         ;POINT 1 PRIOR TO VECTOR START
1349         PUSH    P,E             ;SAVE NUMBER OF ELEMENTS
1350         PUSH    P,EXTAC         ;AND UNIFORM TYPE
1351
1352 UNLOOP: MOVE    B,(P)           ;GET TYPE
1353         MOVE    A,1(C)          ;AND GOODIE
1354         TLO     C,400000        ;CAN'T MUNG TYPE
1355         PUSHJ   P,MARK          ;MARK THIS ONE
1356         MOVEM   A,1(C)          ; LIST FIXUP
1357         SOSE    -1(P)           ;COUNT
1358         AOJA    C,UNLOOP        ;IF MORE, DO NEXT
1359
1360         ADJSP   P,-2            ;REMOVE STACK CRAP
1361         JRST    UMOVEC
1362
1363
1364 SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR
1365         ADJSP   P,-4            ; REOVER
1366         JRST    AFIXUP
1367
1368
1369 \f
1370 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
1371 ; AND UPDATES PTR TO THE TABLE.
1372
1373 GCRDMK: PUSH    P,A             ; SAVE PTR TO TOP
1374         MOVEI   0,(FPTR)        ; SAVE PTR TO INF
1375         PUSH    P,0
1376         PUSHJ   P,GETLNT        ; GET TO D.W. AND CHECK MARKING
1377         JRST    GCRDRL          ; RELATIVIZE
1378         PUSH    P,A             ; SAVE D.W POINTER
1379         SUBI    A,2
1380         MOVE    B,ABOTN         ; GET TOP OF ATOM TABLE
1381         HRRZ    0,-2(P)
1382         ADD     B,0             ; GET BOTTOM OF ATOM TABLE
1383 GCRD1:  CAMG    A,B             ; DON'T SKIP IF DONE
1384         JRST    GCRD2
1385         HLRZ    C,(A)           ; GET MARKING
1386         TRZN    C,400000        ; SKIP IF MARKED
1387         JRST    GCRD3
1388         MOVEI   E,(A)
1389         SUBI    A,(C)           ; GO BACK ONE ATOM
1390         PUSH    P,B             ; SAVE B
1391         PUSH    P,A             ; SAVE POINTER
1392         MOVEI   C,-2(E)         ; SET UP POINTER
1393         MOVEI   B,TATOM         ; GO TO MARK
1394         MOVE    A,1(C)
1395         PUSHJ   P,MARK
1396         MOVEM   A,1(C)          ; SMASH FIXED UP ATOM BACK IN
1397         POP     P,A
1398         POP     P,B
1399         JRST    GCRD1
1400 GCRD3:  SUBI    A,(C)           ; TO NEXT ATOM
1401         JRST    GCRD1
1402 GCRD2:  POP     P,B             ; GET PTR TO D.W.
1403         POP     P,C             ; GET PTR TO INF
1404         ADJSP   P,-1            ; GET RID OF TOP
1405         MOVE    A,B
1406         JRST    ATMOVX          ; RELATIVIZE AND LEAVE
1407
1408 GCRDRL: POP     P,A             ; GET PTR TO D.W
1409         ADJSP   P,-2            ; GET RID OF TOP AND PTR TO INF
1410         JRST    ATMREL          ; RELATAVIZE
1411
1412 \f
1413 ;MARK RELATAVIZED GLOC HACKS
1414
1415 LOCRMK: SKIPE   GCHAIR
1416         JRST    GCRET
1417 LOCRDP: PUSH    P,C             ; SAVE C
1418         MOVEI   C,-2(A)         ; RELATAVIZED PTR TO ATOM
1419         ADD     C,GLTOP         ; ADD GLOTOP TO GET TO ATOM
1420         MOVEI   B,TATOM         ; ITS AN ATOM
1421         SKIPL   (C)
1422         PUSHJ   P,MARK1
1423         POP     P,C             ; RESTORE C
1424         MOVE    A,1(C)          ; GET RELATIVIZATION
1425         MOVEM   A,(P)           ; IT STAYS THE SAVE
1426         JRST    GCRET
1427
1428 ;MARK LOCID TYPE GOODIES
1429
1430 LOCMK:  HRRZ    B,(C)           ;GET TIME
1431         JUMPE   B,LOCMK1        ; SKIP LEGAL CHECK FOR GLOBAL
1432         HRRZ    0,2(A)          ; GET OTHER TIME
1433         CAIE    0,(B)           ; SAME?
1434         SETZB   A,(P)           ; NO, SMASH LOCATIVE
1435         JUMPE   A,GCRET         ; LEAVE IF DONE
1436 LOCMK1: PUSH    P,C
1437         MOVEI   B,TATOM         ; MARK ATOM
1438         MOVEI   C,-2(A)         ; POINT TO ATOM
1439         MOVE    E,(C)           ; SEE IF BLOCK IS MARKED
1440         TLNE    E,400000                ; SKIP IF MARKED
1441         JRST    LOCMK2          ; SKIP OVER BLOCK
1442         SKIPN   GCHAIR          ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED)
1443         PUSHJ   P,MARK1         ; LET LOCATIVE SAVE THE ATOM
1444 LOCMK2: POP     P,C
1445         HRRZ    E,(C)           ; TIME BACK
1446         MOVEI   B,TVEC          ; ASSUME GLOBAL
1447         SKIPE   E
1448         MOVEI   B,TTP           ; ITS LOCAL
1449         PUSHJ   P,MARK1         ; MARK IT
1450         MOVEM   A,(P)
1451         JRST    GCRET
1452
1453 \f
1454 ; MARK ASSOCIATION BLOCKS
1455
1456 ASMRK:  PUSH    P,A
1457 ASMRK1: HRLI    A,-ASOLNT       ;LOOK LIKE A VECTOR POINTER
1458         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
1459         JRST    ASTREL          ; ALREADY MARKED
1460         MOVEI   C,-ASOLNT-1(A)          ;COPY POINTER
1461         PUSHJ   P,MARK2         ;MARK ITEM CELL
1462         MOVEM   A,1(C)
1463         ADDI    C,INDIC-ITEM    ;POINT TO INDICATOR
1464         PUSHJ   P,MARK2
1465         MOVEM   A,1(C)
1466         ADDI    C,VAL-INDIC
1467         PUSHJ   P,MARK2
1468         MOVEM   A,1(C)
1469         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL FRIENDS
1470         JRST    ASTREL
1471         HRRZ    A,NODPNT-VAL(C) ; NEXT
1472         JUMPN   A,ASMRK1                ; IF EXISTS, GO
1473 ASTREL: POP     P,A             ; RESTORE PTR TO ASSOCIATION
1474         MOVEI   A,ASOLNT+1(A)   ; POINT TO D.W.
1475         SKIPN   NODPNT-ASOLNT-1(A)      ; SEE IF EMPTY NODPTR
1476         JRST    ASTX            ; JUMP TO SEND OUT
1477 ASTR1:  HRRZ    E,(A)           ; RELATAVIZE
1478         SUBI    E,(A)
1479         ADDM    E,(P)
1480         JRST    GCRET           ; EXIT
1481 ASTX:   HRRZ    C,(A)           ; GET PTR IN FRONTEIR
1482         SUBI    C,ASOLNT+1      ; ADJUST TO POINT TO BEGINNING
1483         MOVE    B,A
1484         PUSHJ   P,XBLTR
1485         JRST    ASTR1
1486
1487 ;HERE WHEN A VECTOR POINTER IS BAD
1488
1489 VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE
1490         ADJSP   P,-1            ; RECOVERY
1491 AFIXUP: SETZM   (P)             ; CLOBBER SLOT
1492         JRST    GCRET           ; CONTINUE
1493
1494
1495 VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE
1496         ADJSP   P,-2
1497         JRST    AFIXUP          ; RECOVER
1498
1499 PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE
1500         ADJSP   P,-1    ; RECOVER
1501         JRST    AFIXUP
1502
1503
1504 \f; HERE TO MARK TEMPLATE DATA STRUCTURES
1505
1506 TD.MRK: MOVEI   0,(FPTR)        ; SAVE PTR TO INF
1507         PUSH    P,0
1508         HLRZ    B,(A)           ; GET REAL SPEC TYPE
1509         ANDI    B,37777         ; KILL SIGN BIT
1510         MOVEI   E,-NUMSAT-1(B)  ; GET REL POINTER TO TABLE
1511         HRLI    E,(E)
1512         ADD     E,TD.AGC+1
1513         HRRZS   C,A             ; FLUSH COUNT AND SAVE
1514         SKIPL   E               ; WITHIN BOUNDS
1515         FATAL   BAD SAT IN AGC
1516         PUSHJ   P,GETLNT        ; GOODIE IS NOW MARKED
1517         JRST    TMPREL          ; ALREADY MARKED
1518
1519         SKIPE   (E)
1520         JRST    USRAGC
1521         SUB     E,TD.AGC+1      ; POINT TO LENGTH
1522         ADD     E,TD.LNT+1
1523         XCT     (E)             ; RET # OF ELEMENTS IN B
1524
1525         HLRZ    D,B             ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
1526         PUSH    P,[0]           ; TEMP USED IF RESTS EXIST
1527         PUSH    P,D
1528         MOVEI   B,(B)           ; ZAP TO ONLY LENGTH
1529         PUSH    P,C             ; SAVE POINTER TO TEMPLATE STRUCTURE
1530         PUSH    P,[0]           ; HOME FOR VALUES
1531         PUSH    P,[0]           ; SLOT FOR TEMP
1532         PUSH    P,B             ; SAVE
1533         SUB     E,TD.LNT+1
1534         PUSH    P,E             ; SAVE FOR FINDING OTHER TABLES
1535         JUMPE   D,TD.MR2        ; NO REPEATING SEQ
1536         ADD     E,TD.GET+1      ; COMP LNTH OF REPEATING SEQ
1537         HLRE    E,(E)           ; E ==> - LNTH OF TEMPLATE
1538         ADDI    E,(D)           ; E ==> -LENGTH OF REP SEQ
1539         MOVNS   E
1540         HRLM    E,-5(P)         ; SAVE IT AND BASIC
1541
1542 TD.MR2: SKIPG   D,-1(P)         ; ANY LEFT?
1543         JRST    TD.MR1
1544
1545         MOVE    E,TD.GET+1
1546         ADD     E,(P)
1547         MOVE    E,(E)           ; POINTER TO VECTOR IN E
1548         MOVEM   D,-6(P)         ; SAVE ELMENT #
1549         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST
1550         SOJA    D,TD.MR3
1551
1552         MOVEI   0,(B)           ; BASIC LNT TO 0
1553         SUBI    0,(D)           ; SEE IF PAST BASIC
1554         JUMPGE  0,.-3           ; JUMP IF O.K.
1555         MOVSS   B               ; REP LNT TO RH, BASIC TO LH
1556         IDIVI   0,(B)           ; A==> -WHICH REPEATER
1557         MOVNS   A
1558         ADD     A,-5(P)         ; PLUS BASIC
1559         ADDI    A,1             ; AND FUDGE
1560         MOVEM   A,-6(P)         ; SAVE FOR PUTTER
1561         ADDI    E,-1(A)         ; POINT
1562         SOJA    D,.+2
1563
1564 TD.MR3: ADDI    E,(D)           ; POINT TO SLOT
1565         XCT     (E)             ; GET THIS ELEMENT INTO A AND B
1566         JFCL                    ; NO-OP FOR ANY CASE
1567         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT
1568         MOVEM   B,-2(P)
1569         EXCH    A,B             ; REARRANGE
1570         GETYP   B,B
1571         MOVEI   C,-3(P)         ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG
1572         MOVSI   D,400000        ; RESET FOR MARK
1573         PUSHJ   P,MARK          ; AND MARK THIS GUY (RET FIXED POINTER IN A)
1574         MOVE    C,-4(P)         ; REGOBBLE POINTER TO TEMPLATE
1575         MOVE    E,TD.PUT+1
1576         MOVE    B,-6(P)         ; RESTORE COUNT
1577         ADD     E,(P)
1578         MOVE    E,(E)           ; POINTER TO VECTOR IN E
1579         ADDI    E,(B)-1         ; POINT TO SLOT
1580         MOVE    B,-3(P)         ; RESTORE TYPE WORD
1581         EXCH    A,B
1582         SOS     D,-1(P)         ; GET ELEMENT #
1583         XCT     (E)             ; SMASH IT BACK
1584         FATAL TEMPLATE LOSSAGE
1585         MOVE    C,-4(P)         ; RESTORE POINTER IN CASE MUNGED
1586         JRST    TD.MR2
1587
1588 TD.MR1: MOVE    A,-8(P)         ; PTR TO DOPE WORD
1589         MOVE    B,-7(P)         ; RESTORE PTR TO FRONTEIR
1590         ADJSP   P,-7            ; CLEAN UP STACK
1591 USRAG1: ADDI    A,1             ; POINT TO SECOND D.W.
1592         MOVSI   D,400000        ; SET UP MARK BIT
1593         MOVE    B,A
1594         HRRZ    C,(A)           ; DEST DW
1595         DOMULT  [HLRZ   E,(C)]  ; LENGTH
1596         SUBI    C,-1(E)
1597         PUSHJ   P,XBLTR
1598 TMPREL: ADJSP   P,-1
1599         HRRZ    D,(A)
1600         SUBI    D,(A)
1601         ADDM    D,(P)
1602         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT
1603         JRST    GCRET
1604
1605 USRAGC: HRRZ    E,(E)           ; MARK THE TEMPLATE
1606         PUSHJ   P,(E)
1607         MOVE    A,-1(P)         ; POINTER TO D.W
1608         MOVE    B,(P)           ; TOINTER TO FRONTIER
1609         JRST    USRAG1
1610
1611 ;  This phase attempts to remove any unwanted associations.  The program
1612 ; loops through the structure marking values of associations.  It can only
1613 ; stop when no new values (potential items and/or indicators) are marked.
1614
1615 VALFLS: PUSH    P,LPVP          ; SAVE LPVP FOR LATER
1616         PUSH    P,[0]           ; INDICATE WHETHER ANY ON THIS PASS
1617         PUSH    P,[0]           ; OR THIS BUCKET
1618 ASOMK1: MOVE    A,GCASOV        ; GET VECTOR POINTER
1619         SETOM   -1(P)           ; INITIALIZE FLAG
1620
1621 ASOM6:  SKIPG   C,(A)           ; SKIP IF BUCKET TO BE SCANNED
1622         JRST    ASOM1
1623         SETOM   (P)             ; SAY BUCKET NOT CHANGED
1624
1625 ASOM2:  MOVEI   EXTAC,(C)               ; COPY POINTER
1626         SKIPG   ASOLNT+1(C)     ; SKIP IF NOT ALREADY MARKED
1627         JRST    ASOM4           ; MARKED, GO ON
1628         PUSHJ   P,MARKQ         ; SEE IF ITEM IS MARKED
1629         JRST    ASOM3           ; IT IS NOT, IGNORE IT
1630         MOVEI   EXTAC,(C)       ; IN CASE CLOBBERED BY MARK2
1631         MOVEI   C,INDIC(C)      ; POINT TO INDICATOR SLOT
1632         PUSHJ   P,MARKQ
1633         JRST    ASOM3           ; NOT MARKED
1634
1635         PUSH    P,A             ; HERE TO MARK VALUE
1636         PUSH    P,EXTAC
1637         HLRE    EXTAC,ASOLNT-INDIC+1(C) ; GET LENGTH
1638         JUMPL   EXTAC,.+3               ; SKIP IF MARKED
1639         CAMGE   C,VECBOT        ; SKIP IF IN VECT SPACE
1640         JRST    ASOM20
1641         HRRM    FPTR,ASOLNT-INDIC+1(C)  ; PUT IN RELATIVISATION
1642         MOVEI   EXTAC,12        ; AMOUNT TO ALLOCATE IN INF
1643         PUSHJ   P,ALLOGC
1644         HRRM    0,5(C)          ; STICK IN RELOCATION
1645
1646 ASOM20: PUSHJ   P,MARK2         ; AND MARK
1647         MOVEM   A,1(C)          ; LIST FIX UP
1648         ADDI    C,ITEM-INDIC    ; POINT TO ITEM
1649         PUSHJ   P,MARK2
1650         MOVEM   A,1(C)
1651         ADDI    C,VAL-ITEM      ; POINT TO VALUE
1652         PUSHJ   P,MARK2
1653         MOVEM   A,1(C)
1654         IORM    D,ASOLNT-VAL+1(C)       ; MARK ASOC BLOCK
1655         POP     P,EXTAC
1656         POP     P,A
1657         AOSA    -1(P)           ; INDICATE A MARK TOOK PLACE
1658
1659 ASOM3:  AOS     (P)             ; INDICATE AN UNMARKED IN THIS BUCKET
1660 ASOM4:  HRRZ    C,ASOLNT-1(EXTAC)       ; POINT TO NEXT IN BUCKET
1661         JUMPN   C,ASOM2         ; IF NOT EMPTY, CONTINUE
1662         SKIPGE  (P)             ; SKIP IF ANY NOT MARKED
1663         HRROS   (A)             ; MARK BUCKET AS NOT INTERESTING
1664 ASOM1:  AOBJN   A,ASOM6         ; GO TO NEXT BUCKET
1665         MOVE    0,.ATOM.
1666         SETZM   .ATOM.
1667         JUMPN   0,VALFLA        ; YES, CHECK VALUES
1668 VALFL8:
1669
1670 ; NOW SEE WHICH CHANNELS STILL POINTED TO
1671
1672 CHNFL3: MOVEI   0,N.CHNS-1
1673         MOVEI   A,CHNL1 ; SLOTS
1674         HRLI    E,TCHAN         ; TYPE HERE TOO
1675
1676 CHNFL2: SKIPN   B,1(A)
1677         JRST    CHNFL1
1678         HLRE    C,B
1679         SUBI    B,(C)           ; POINT TO DOPE
1680         HLLM    E,(A)           ; PUT TYPE BACK
1681         HRRE    EXTAC,(A)       ; SEE IF ALREADY MARKED
1682         JUMPN   EXTAC,CHNFL1
1683         SKIPGE  1(B)
1684         JRST    CHNFL8
1685         HLLOS   (A)             ; MARK AS A LOSER
1686         SETZM   -1(P)
1687         JRST    CHNFL1
1688 CHNFL8: MOVEI   EXTAC,1 ; MARK A GOOD CHANNEL
1689         HRRM    EXTAC,(A)
1690 CHNFL1: ADDI    A,2
1691         SOJG    0,CHNFL2
1692
1693         SKIPE   GCHAIR          ; IF NOT HAIRY CASE
1694         POPJ    P,              ; LEAVE
1695
1696         SKIPL   -1(P)           ; SKIP IF NOTHING NEW MARKED
1697         JRST    ASOMK1
1698
1699         ADJSP   P,-2            ; REMOVE FLAGS
1700
1701
1702
1703 ; HERE TO REEMOVE UNUSED ASSOCIATIONS
1704
1705         MOVE    A,GCASOV        ; GET ASOVEC BACK FOR FLUSHES
1706
1707 ASOFL1: SKIPN   C,(A)           ; SKIP IF BUCKET NOT EMPTY
1708         JRST    ASOFL2          ; EMPTY BUCKET, IGNORE
1709         HRRZS   (A)             ; UNDO DAMAGE OF BEFORE
1710
1711 ASOFL5: SKIPGE  ASOLNT+1(C)     ; SKIP IF UNMARKED
1712         JRST    ASOFL6          ; MARKED, DONT FLUSH
1713
1714         HRRZ    B,ASOLNT-1(C)   ; GET FORWARD POINTER
1715         HLRZ    E,ASOLNT-1(C)   ; AND BACK POINTER
1716         JUMPN   E,ASOFL4        ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)
1717         HRRZM   B,(A)           ; FIX BUCKET
1718         JRST    .+2
1719
1720 ASOFL4: HRRM    B,ASOLNT-1(E)   ; FIX UP PREVIOUS
1721         JUMPE   B,.+2           ; JUMP IF NO NEXT POINTER
1722         HRLM    E,ASOLNT-1(B)   ; FIX NEXT'S BACK POINTER
1723         HRRZ    B,NODPNT(C)     ; SPLICE OUT THRAD
1724         HLRZ    E,NODPNT(C)
1725         SKIPE   E
1726         HRRM    B,NODPNT(E)
1727         SKIPE   B
1728         HRLM    E,NODPNT(B)
1729
1730 ASOFL3: HRRZ    C,ASOLNT-1(C)   ; GO TO NEXT
1731         JUMPN   C,ASOFL5
1732 ASOFL2: AOBJN   A,ASOFL1
1733
1734
1735 \f
1736 ; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES
1737
1738         MOVE    A,GCGBSP        ; GET GLOBAL PDL
1739
1740 GLOFLS: SKIPGE  (A)             ; SKIP IF NOT ALREADY MARKED
1741         JRST    SVDCL
1742         MOVSI   B,-3
1743         PUSHJ   P,ZERSLT        ; CLOBBER THE SLOT
1744         HLLZS   (A)
1745 SVDCL:  ANDCAM  D,(A)           ; UNMARK
1746         ADD     A,[4,,4]
1747         JUMPL   A,GLOFLS        ; MORE?, KEEP LOOPING
1748
1749         MOVEM   LPVP,(P)
1750 LOCFL1: HRRZ    A,(LPVP)        ; NOW CLOBBER LOCAL SLOTS
1751         HRRZ    C,2(LPVP)
1752         MOVEI   LPVP,(C)
1753         JUMPE   A,LOCFL2        ; NONE TO FLUSH
1754
1755 LOCFLS: SKIPGE  (A)             ; MARKDE?
1756         JRST    .+3
1757         MOVSI   B,-5
1758         PUSHJ   P,ZERSLT
1759         ANDCAM  D,(A)           ;UNMARK
1760         HRRZ    A,(A)           ; GO ON
1761         JUMPN   A,LOCFLS
1762 LOCFL2: JUMPN   LPVP,LOCFL1     ; JUMP IF MORE PROCESS
1763
1764 ; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT.
1765 ; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING.
1766 ; IT FIXES UP THE SP-CHAIN AND IT
1767 ; SENDS OUT THE ATOMS.
1768
1769 LOCFL3: MOVE    C,(P)
1770         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
1771         PUSHJ   P,MARK1         ; MARK THE ATOM
1772         MOVEM   A,1(C)          ; NEW HOME
1773         MOVEI   C,2(C)          ; MARK VALUE
1774         MOVEI   B,TPVP          ; IT IS A PROCESS VECTOR POINTER
1775         PUSHJ   P,MARK1         ; MARK IT
1776         MOVEM   A,1(C)
1777         POP     P,R
1778 NEXPRO: MOVEI   0,TPVP          ; FIX UP SLOT
1779         HLRZ    A,2(R)          ; GET PTR TO NEXT PROCESS
1780         HRLM    0,2(R)
1781         HRRZ    E,(A)           ; ADRESS IN INF
1782         HRRZ    B,(A)           ; CALCULATE RELOCATION
1783         SUB     B,A
1784         PUSH    P,B
1785         HRRZ    EXTAC,A         ; CALCULATE START OF TP IN EXTAC
1786         HLRZ    B,(A)           ; ADJUST INF PTR
1787         TRZ     B,400000
1788         SUBI    EXTAC,-1(B)
1789         LDB     M,[TOPGRO,,-1(A)]       ; CALCULATE TOP GROWTH
1790         TRZE    M,400           ; FUDGE SIGN
1791         MOVNS   M
1792         ASH     M,6
1793         ADD     B,M             ; FIX UP LENGTH
1794         EXCH    M,(P)
1795         SUBM    M,(P)           ; FIX RELOCATION TO TAKE INTO ACCOUNT
1796                                 ;       CHANGE IN LENGTH
1797         MOVE    M,R             ; GET A COPY OF R
1798 NEXP1:  HRRZ    C,(M)           ; GET PTR TO NEXT IN CHAIN
1799         JUMPE   C,NEXP2         ; EXIT IF END OF CHAIN
1800         MOVE    0,C             ; GET COPY OF CHAIN PTR TO UPDATE
1801         ADD     0,(P)           ; UPDATE
1802         HRRM    0,(M)           ; PUT IN
1803         MOVE    M,C             ; NEXT
1804         JRST    NEXP1
1805 NEXP2:  ADJSP   P,-1            ; CLEAN UP STACK
1806         SUBI    E,-1(B)
1807         MOVEI   A,6(R)          ; POINT AFTER THE BINDING
1808         MOVE    0,EXTAC         ; CALCULATE # OF WORDS TO SEND OUT
1809         SUBM    A,0
1810         HRRZ    A,EXTAC
1811         MOVE    B,E
1812         HRLI    B,GCSEG
1813         DOMULT  [XBLT   0,]
1814         HRRZS   R,2(R)          ; GET THE NEXT PROCESS
1815         JUMPE   R,.+3
1816         PUSH    P,R
1817         JRST    LOCFL3
1818         MOVE    A,GCGBSP        ; PTR TO GLOBAL STACK
1819         PUSHJ   P,SPCOUT        ; SEND IT OUT
1820         MOVE    A,GCASOV
1821         PUSHJ   P,SPCOUT        ; SEND IT OUT
1822         POPJ    P,
1823
1824 ; THIS ROUTINE MARKS ALL THE CHANNELS
1825 ; IT THEN SENDS OUT A COPY OF THE TVP
1826
1827 CHFIX:  MOVEI   0,N.CHNS-1
1828         MOVEI   A,CHNL1         ; SLOTS
1829         HRLI    E,TCHAN         ; TYPE HERE TOO
1830
1831 DHNFL2: SKIPN   B,1(A)
1832         JRST    DHNFL1
1833         MOVEI   C,(A)           ; MARK THE CHANNEL
1834         PUSH    P,0             ; SAVE 0
1835         PUSH    P,A             ; SAVE A
1836         PUSHJ   P,MARK2
1837         MOVEM   A,1(C)          ; ADJUST PTR
1838         POP     P,A             ; RESTORE A
1839         POP     P,0             ; RESTORE
1840 DHNFL1: ADDI    A,2
1841         SOJG    0,DHNFL2
1842         POPJ    P,
1843
1844
1845 ; ROUTINE TO SEND OUT STUFF - SPCOUX--DONT LOOK AT GROWTH
1846 ;                             SPCOUT--LOOK AT GROWTH
1847
1848 SPCOUX: TDZA    C,C             ; ZERO C AS FLAG
1849
1850 SPCOUT: MOVEI   C,1
1851         HLRE    B,A
1852         SUB     A,B
1853         MOVEI   A,1(A)          ; POINT TO DOPE WORD
1854         CAMGE   A,GCSBOT
1855         POPJ    P,
1856         HLLZ    0,-1(A)         ; MODIFY DOPE WORD AND PLACE IN INF
1857         TLO     0,.VECT.
1858         HRRZ    B,(A)           ; DESTINATION OF DOPEWORDS (SORT OF)
1859         HRLI    B,GCSEG         ; MAKE INTO CORRECT KIND OF ADDR
1860         DOMULT  [MOVEM  0,-1(B)]
1861         JUMPE   C,SPCOUY        ; JUMP IF NO GROWTH STUFF
1862         LDB     C,[BOTGRO,,-1(A)]
1863         TRZE    C,400
1864         MOVNS   C
1865         ASH     C,6
1866 SPCOUY: DOMULT  [HLRZ   0,(B)]
1867         ADD     0,C             ; COMPENSATE FOR SHRINKAGE
1868         SUBI    0,1             ; DONT RESEND DW
1869         SUB     A,0
1870         SUB     B,0
1871         DOMULT  [XBLT   0,]             ; MOVE VECTOR TO OTHER IMAGE
1872         POPJ    P,              ;RETURN
1873
1874 ASOFL6: HLRZ    E,ASOLNT-1(C)   ; SEE IF FIRST IN BUCKET
1875         JUMPN   E,ASOFL3        ; IF NOT CONTINUE
1876         HRRZ    E,ASOLNT+1(C)   ; GET PTR FROM DOPE WORD
1877         SUBI    E,ASOLNT+1      ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION
1878         HRRZM   E,(A)           ; SMASH IT IN
1879         JRST    ASOFL3
1880
1881
1882 MARK23: PUSH    P,A             ; SAVE BUCKET POINTER
1883         PUSH    P,EXTAC
1884         PUSHJ   P,MARK2
1885         MOVEM   A,1(C)
1886         POP     P,EXTAC
1887         POP     P,A
1888         AOS     -2(P)           ; MARKING HAS OCCURRED
1889         IORM    D,ASOLNT+1(C)   ; MARK IT
1890         JRST    MKD
1891
1892 \f; CHANNEL FLUSHER FOR NON HAIRY GC
1893
1894 CHNFLS: PUSH    P,[-1]
1895         SETOM   (P)             ; RESET FOR RETRY
1896         PUSHJ   P,CHNFL3
1897         SKIPL   (P)
1898         JRST    .-3             ; REDO
1899         ADJSP   P,-1
1900         POPJ    P,
1901
1902 ; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP
1903
1904 VALFLA: MOVE    C,GCGBSP        ; GET POINTER TO GLOBAL STACK
1905 VALFL1: SKIPL   (C)             ; SKIP IF NOT MARKED
1906         PUSHJ   P,MARKQ         ; SEE IF ATOM IS MARKED
1907         JRST    VALFL2
1908         PUSH    P,C
1909         MOVEI   B,TATOM         ; UPDATE ATOM SLOT
1910         PUSHJ   P,MARK1
1911         MOVEM   A,1(C)
1912         IORM    D,(C)
1913         AOS     -2(P)           ; INDICATE MARK OCCURRED
1914         HRRZ    B,(C)           ; GET POSSIBLE GDECL
1915         JUMPE   B,VLFL10        ; NONE
1916         CAIN    B,-1            ; MAINFIFEST
1917         JRST    VLFL10
1918         MOVEI   A,(B)
1919         MOVEI   B,TLIST
1920         MOVEI   C,0
1921         PUSHJ   P,MARK          ; MARK IT
1922         MOVE    C,(P)           ; POINT
1923         HRRM    A,(C)           ; CLOBBER UPDATE IN
1924 VLFL10: ADD     C,[2,,2]        ; BUMP TO VALUE
1925         PUSHJ   P,MARK2         ; MARK VALUE
1926         MOVEM   A,1(C)
1927         POP     P,C
1928 VALFL2: ADD     C,[4,,4]
1929         JUMPL   C,VALFL1        ; JUMP IF MORE
1930
1931         HRLM    LPVP,(P)        ; SAVE POINTER
1932 VALFL7: MOVEI   C,(LPVP)
1933         MOVEI   LPVP,0
1934 VALFL6: HRRM    C,(P)
1935
1936 VALFL5: HRRZ    C,(C)           ; CHAIN
1937         JUMPE   C,VALFL4
1938         MOVEI   B,TATOM         ; TREAT LIKE AN ATOM
1939         SKIPL   (C)             ; MARKED?
1940         PUSHJ   P,MARKQ1        ; NO, SEE
1941         JRST    VALFL5          ; LOOP
1942         AOS     -1(P)           ; MARK WILL OCCUR
1943         MOVEI   B,TATOM         ; RELATAVIZE
1944         PUSHJ   P,MARK1
1945         MOVEM   A,1(C)
1946         IORM    D,(C)
1947         ADD     C,[2,,2]        ; POINT TO VALUE
1948         PUSHJ   P,MARK2         ; MARK VALUE
1949         MOVEM   A,1(C)
1950         SUBI    C,2
1951         JRST    VALFL5
1952
1953 VALFL4: HRRZ    C,(P)           ; GET SAVED LPVP
1954         MOVEI   A,(C)
1955         HRRZ    C,2(C)          ; POINT TO NEXT
1956         JUMPN   C,VALFL6
1957         JUMPE   LPVP,VALFL9
1958
1959         HRRM    LPVP,2(A)       ; NEW PROCESS WAS MARKED
1960         JRST    VALFL7
1961
1962 ZERSLT: HRRI    B,(A)           ; COPY POINTER
1963         SETZM   1(B)
1964         AOBJN   B,.-1
1965         POPJ    P,
1966
1967 VALFL9: HLRZ    LPVP,(P)        ; RESTORE CHAIN
1968         JRST    VALFL8
1969
1970 \f;SUBROUTINE TO SEE IF A GOODIE IS MARKED
1971 ;RECEIVES POINTER IN C
1972 ;SKIPS IF MARKED NOT OTHERWISE
1973
1974 MARKQ:  HLRZ    B,(C)           ;TYPE TO B
1975 MARKQ1: MOVE    E,1(C)          ;DATUM TO C
1976         MOVEI   0,(E)
1977         CAIL    0,@PURBOT       ; DONT CHACK PURE
1978         JRST    MKD             ; ALWAYS MARKED
1979         ANDI    B,TYPMSK        ; FLUSH MONITORS
1980         LSH     B,1
1981         HRRZ    B,@TYPNT        ;GOBBLE SAT
1982         ANDI    B,SATMSK
1983         CAIG    B,NUMSAT        ; SKIP FOR TEMPLATE
1984         JRST    @MQTBS(B)       ;DISPATCH
1985         ANDI    E,-1            ; FLUSH REST HACKS
1986         JRST    VECMQ
1987
1988
1989 MQTBS:
1990
1991 OFFSET 0
1992
1993 DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
1994 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ]
1995 [SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]
1996 [SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ]
1997 [SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]]
1998
1999 OFFSET OFFS
2000
2001 PAIRMQ: JUMPE   E,MKD           ; NIL ALWAYS MARKED
2002         SKIPL   (E)             ; SKIP IF MARKED
2003         POPJ    P,
2004 ARGMQ:
2005 MKD:    AOS     (P)
2006         POPJ    P,
2007
2008 BYTMQ:  PUSH    P,A             ; SAVE A
2009         PUSHJ   P,BYTDOP                ; GET PTR TO DOPE WORD
2010         MOVE    E,A             ; COPY POINTER
2011         POP     P,A             ; RESTORE A
2012         SKIPGE  (E)             ; SKIP IF NOT MARKED
2013         AOS     (P)
2014         POPJ    P,              ; EXIT
2015
2016 FRMQ:   HRRZ    E,(C)           ; POINT TO PV DOPE WORD
2017         SOJA    E,VECMQ1
2018
2019 ATMMQ:  CAML    0,GCSBOT        ; ALWAYS KEEP FROZEN ATOMS
2020         JRST    VECMQ
2021         AOS     (P)
2022         POPJ    P,
2023
2024 VECMQ:  HLRE    0,E             ;GET LENGTH
2025         SUB     E,0             ;POINT TO DOPE WORDS
2026
2027 VECMQ1: SKIPGE  1(E)            ;SKIP IF NOT MARKED
2028         AOS     (P)             ;MARKED, CAUSE SKIP RETURN
2029         POPJ    P,
2030
2031 ASMQ:   SUBI    E,ASOLNT
2032         JRST    VECMQ1
2033
2034 LOCMQ:  HRRZ    0,(C)           ; GET TIME
2035         JUMPE   0,VECMQ         ; GLOBAL, LIKE VECTOR
2036         HLRE    0,E             ; FIND DOPE
2037         SUB     E,0
2038         MOVEI   E,1(E)          ; POINT TO LAST DOPE
2039         CAMN    E,TPGROW                ; GROWING?
2040         SOJA    E,VECMQ1        ; YES, CHECK
2041         ADDI    E,PDLBUF        ; FUDGE
2042         MOVSI   0,-PDLBUF
2043         ADDM    0,1(C)
2044         SOJA    E,VECMQ1
2045
2046 OFFSMQ: HLRZS   E               ; POINT TO LIST STRUCTURE
2047         SKIPGE  (E)             ; MARKED?
2048          AOS    (P)             ; YES
2049         POPJ    P,
2050
2051 \f; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF
2052
2053 ASSOUP: MOVE    A,GCNOD         ; RECOVER PTR TO START OF CHAIN
2054 ASSOP1: HRRZ    B,NODPNT(A)
2055         PUSH    P,B             ; SAVE NEXT ON CHAIN
2056         PUSH    P,A             ; SAVE IT
2057         HRRZ    B,ASOLNT-1(A)   ;POINT TO NEXT
2058         JUMPE   B,ASOUP1
2059         HRRZ    C,ASOLNT+1(B)   ;AND GET ITS RELOC IN C
2060         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
2061         ADDM    C,ASOLNT-1(A)   ;C NOW HAS UPDATED POINTER
2062 ASOUP1: HLRZ    B,ASOLNT-1(A)   ;GET PREV BLOCK POINTER
2063         JUMPE   B,ASOUP2
2064         HRRZ    EXTAC,ASOLNT+1(B)       ;AND ITS RELOCATION
2065         SUBI    EXTAC,ASOLNT+1(B)       ; RELATIVIZE
2066         MOVSI   EXTAC,(EXTAC)
2067         ADDM    EXTAC,ASOLNT-1(A)       ;RELOCATE
2068 ASOUP2: HRRZ    B,NODPNT(A)             ;UPDATE NODE CHAIN
2069         JUMPE   B,ASOUP4
2070         HRRZ    C,ASOLNT+1(B)           ;GET RELOC
2071         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
2072         ADDM    C,NODPNT(A)     ;AND UPDATE
2073 ASOUP4: HLRZ    B,NODPNT(A)     ;GET PREV POINTER
2074         JUMPE   B,ASOUP5
2075         HRRZ    EXTAC,ASOLNT+1(B)       ;RELOC
2076         SUBI    EXTAC,ASOLNT+1(B)
2077         MOVSI   EXTAC,(EXTAC)
2078         ADDM    EXTAC,NODPNT(A)
2079 ASOUP5: POP     P,A             ; RECOVER PTR TO DOPE WORD
2080         MOVEI   A,ASOLNT(A)
2081         PUSHJ   P,SPCOUX
2082         POP     P,A             ; RECOVER PTR TO ASSOCIATION
2083         JUMPN   A,ASSOP1        ; IF NOT ZERO CONTINUP
2084         POPJ    P,              ; DONE
2085
2086 \f
2087 ; HERE TO CLEAN UP ATOM HASH TABLE
2088
2089 ATCLEA: MOVE    A,GCHSHT        ; GET TABLE POINTER
2090
2091 ATCLE1: MOVEI   B,0
2092         SKIPE   C,(A)           ; GET NEXT
2093         JRST    ATCLE2          ; GOT ONE
2094
2095 ATCLE3: PUSHJ   P,OUTATM
2096         AOBJN   A,ATCLE1
2097
2098         MOVE    A,GCHSHT        ; MOVE OUT TABLE
2099         PUSHJ   P,SPCOUT
2100         POPJ    P,
2101
2102 ; HAVE AN ATOM IN C
2103
2104 ATCLE2: MOVEI   B,0
2105
2106 ATCLE5: CAIL    C,HIBOT
2107         JRST    ATCLE3
2108         CAMG    C,VECBOT        ; FROZEN ATOMS ALWAYS MARKED
2109          JRST   .+3
2110         SKIPL   1(C)            ; SKIP IF ATOM MARKED
2111         JRST    ATCLE6
2112
2113         HRRZ    0,1(C)          ; GET DESTINATION
2114         CAIN    0,-1            ; FROZEN/MAGIC ATOM
2115          MOVEI  0,1(C)          ; USE CURRENT POSN
2116         SUBI    0,1             ; POINT TO CORRECT DOPE
2117         JUMPN   B,ATCLE7        ; JUMP IF GOES INTO ATOM
2118
2119         HRRZM   0,(A)           ; INTO HASH TABLE
2120         JRST    ATCLE8
2121
2122 ATCLE7: HRLM    0,2(B)          ; INTO PREV ATOM
2123         PUSHJ   P,OUTATM
2124
2125 ATCLE8: HLRZ    B,1(C)
2126         ANDI    B,377777        ; KILL MARK BIT
2127         SUBI    B,2
2128         HRLI    B,(B)
2129         SUBM    C,B
2130         HLRZ    C,2(B)
2131         JUMPE   C,ATCLE3        ; DONE WITH BUCKET
2132         JRST    ATCLE5
2133
2134 ; HERE TO PASS OVER LOST ATOM
2135
2136 ATCLE6: HLRZ    EXTAC,1(C)              ; FIND NEXT ATOM
2137         SUBI    C,-2(EXTAC)
2138         HLRZ    C,2(C)
2139         JUMPE   B,ATCLE9
2140         HRLM    C,2(B)
2141         JRST    .+2
2142 ATCLE9: HRRZM   C,(A)
2143         JUMPE   C,ATCLE3
2144         JRST    ATCLE5
2145
2146 OUTATM: JUMPE   B,CPOPJ
2147         PUSH    P,A
2148         PUSH    P,C
2149         HLRE    A,B
2150         SUBM    B,A
2151         ANDI    A,-1
2152         PUSHJ   P,SPCOUX
2153         POP     P,C
2154         POP     P,A             ; RECOVER PTR TO ASSOCIATION
2155         POPJ    P,
2156
2157 \f
2158 VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH
2159
2160
2161 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
2162
2163 MSGGCT: [ASCIZ /USER CALLED- /]
2164         [ASCIZ /FREE STORAGE- /]
2165         [ASCIZ /TP-STACK- /]
2166         [ASCIZ /TOP-LEVEL LOCALS- /]
2167         [ASCIZ /GLOBAL VALUES- /]
2168         [ASCIZ /TYPES- /]
2169         [ASCIZ /STATIONARY IMPURE STORAGE- /]
2170         [ASCIZ /P-STACK /]
2171         [ASCIZ /BOTH STACKS BLOWN- /]
2172         [ASCIZ /PURE STORAGE- /]
2173         [ASCIZ /GC-RCALL- /]
2174
2175 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
2176
2177 GCPAT:  SPBLOK 100
2178 EGCPAT: -1
2179 %XXBLT: 020000,,
2180
2181 MSGGFT: [ASCIZ /GC-READ /]
2182         [ASCIZ /BLOAT /]
2183         [ASCIZ /GROW /]
2184         [ASCIZ /LIST /]
2185         [ASCIZ /VECTOR /]
2186         [ASCIZ /SET /]
2187         [ASCIZ /SETG /]
2188         [ASCIZ /FREEZE /]
2189         [ASCIZ /PURE-PAGE LOADER /]
2190         [ASCIZ /GC /]
2191         [ASCIZ /INTERRUPT-HANDLER /]
2192         [ASCIZ /NEWTYPE /]
2193         [ASCIZ /PURIFY /]
2194
2195
2196 .GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL
2197 .GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX
2198 .GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP
2199 .GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB
2200 .GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG
2201 .GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN
2202 .GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR
2203
2204 \f
2205 ;LOCAL VARIABLES
2206
2207 OFFSET 0
2208
2209 IMPURE
2210 ; LOCACTIONS USED BY THE PAGE HACKER
2211
2212
2213
2214 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
2215 ;AND WHEN IT WILL GET UNHAPPY
2216
2217 ;IN GC FLAG
2218
2219 GCHSHT: 0                       ; SAVED ATOM TABLE
2220 PURSVT: 0                       ; SAVED PURVEC TABLE
2221 GLTOP:  0                       ; SAVE GLOTOP
2222 GCNOD:  0                       ; PTR TO START OF ASSOCIATION CHAIN
2223 GCGBSP: 0                       ; SAVED GLOBAL SP
2224 GCASOV: 0                       ; SAVED PTR TO ASSOCIATION VECTOR
2225 GCATM:  0                       ; PTR TO IMQUOT THIS-PROCESS
2226 NPARBO: 0                       ; SAVED PARBOT
2227
2228
2229 ; CONSTANTS FOR DUMPER,READER AND PURIFYER
2230
2231 GENFLG: 0
2232 .ATOM.: 0
2233
2234
2235 ; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR
2236
2237
2238 PURE
2239
2240 OFFSET OFFS
2241
2242 CONSTANTS
2243
2244 HERE
2245 DEFINE HERE G00002,G00003
2246 G00002!G00003!TERMIN
2247
2248 CONSTANTS
2249
2250 OFFSET 0
2251
2252 ZZ==$.+1777
2253
2254 .LOP ANDCM ZZ 1777
2255
2256 ZZ1==.LVAL1
2257
2258 LOC ZZ1
2259
2260
2261 OFFSET OFFS
2262
2263 MRKPD:  SPBLOK  1777
2264 ENDPDL: -1
2265
2266 MRKPDL=MRKPD-1
2267
2268 SENDGC:
2269
2270 OFFSET 0
2271
2272 ZZ2==SENDGC-AGCLD
2273 .LOP <ASH @> ZZ2 <,-10.>
2274 SECLEN==.LVAL1
2275
2276 .LOP <ASH @> SECLEN <,10.>
2277 RSECLE==.LVAL1
2278
2279 .LOP <ASH @> AGCLD <,-10.>
2280 PAGESC==.LVAL1
2281
2282 OFFSET 0
2283
2284 LOC GCST
2285 .LPUR==$.
2286
2287 END
2288