<mdl.int>/secagc.82

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