<mdl.int>/secagc.mid.81

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