<mdl.int>/agc.mid.131

   1 TITLE AGC MUDDLE GARBAGE COLLECTOR
   2
   3 ;SYSTEM WIDE DEFINITIONS GO HERE
   4
   5 RELOCATABLE
   6 GCST==$.
   7
   8
   9 .GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG
  10 .GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT
  11 .GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR
  12 .GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC
  13 .GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC
  14 .GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS
  15 .GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL
  16 .GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI
  17 .GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2
  18 .GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN
  19 .GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT
  20 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
  21
  22 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB
  23 .GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR
  24
  25 .GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10
  26 .GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK
  27 .GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG
  28 .GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET
  29
  30 .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
  31 .GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A
  32
  33 NOPAGS==1       ; NUMBER OF WINDOWS
  34 EOFBIT==1000
  35 PDLBUF=100
  36 NTPMAX==20000   ; NORMAL MAX TP SIZE
  37 NTPGOO==4000    ; NORMAL GOOD TP
  38 ETPMAX==2000    ; TPMAX IN AN EMERGENCY (I.E. GC RECALL)
  39 ETPGOO==2000    ; GOOD TP IN EMERGENCY
  40
  41 .ATOM.==200000  ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC)
  42
  43 GCHN==0         ; CHANNEL FOR FUNNNY INFERIOR
  44 STATNO==19.     ; # OF STATISTICS FOR BLOAT-STAT
  45 STATGC==8.      ; # OF GC-STATISTICS FOR BLOAT-STAT
  46
  47
  48 LOC REALGC
  49 OFFS==AGCLD-$.
  50 GCOFFS=OFFS
  51 OFFSET OFFS
  52
  53 .INSRT MUDDLE >
  54 SYSQ
  55 IFE ITS,[
  56 .INSRT STENEX >
  57 ]
  58 IFN ITS,        PGSZ==10.
  59 IFE ITS,        PGSZ==9.
  60
  61 TYPNT=AB        ;SPECIAL AC USAGE DURING GC
  62 F=TP                            ;ALSO SPECIAL DURING GC
  63 LPVP=SP                         ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN
  64 FPTR=TB                         ; POINT TO CURRENT FRONTIER OF INFERIOR
  65
  66
  67 ; WINDOW AND FRONTIER PAGES
  68
  69 MAPCH==0                        ; MAPPING CHANNEL
  70 .LIST.==400000
  71 FPAG==2000                      ; START OF PAGES FOR GC-READ AND GCDUMP
  72 CONADJ==5                       ; ADJUSTMENT OF DUMPERS CONSTANT TABLE
  73
  74 \f
  75 ; INTERNAL GCDUMP ROUTINE
  76 .GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF
  77
  78 GODUMP: MOVE    PVP,PVSTOR+1
  79         MOVEM   P,PSTO+1(PVP)           ; SAVE P
  80         MOVE    P,GCPDL
  81         PUSH    P,AB
  82         PUSHJ   P,INFSU1        ; SET UP INFERIORS
  83
  84 ; MARK PHASE
  85         SETZM   PURMNG          ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES
  86                                 ; WERE MUNGED
  87         MOVEI   0,HIBOT         ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR
  88                                 ; TO COLLECT PURIFIED STRUCTURES
  89         EXCH    0,PURBOT
  90         MOVEM   0,RPURBT        ; SAVE THE OLD PURBOT
  91         MOVEI   0,HIBOT
  92         EXCH    0,GCSTOP
  93         MOVEM   0,RGCSTP        ; SAVE THE OLD GCSTOP
  94         POP     P,C             ; SET UP PTR TO TYPE/VALUE PAIR
  95         MOVE    P,A             ; GET NEW PDL PTR
  96         SETOM   DUMFLG          ; FLAG INDICATING IN DUMPER
  97         MOVE    A,TYPVEC+1
  98         MOVEM   A,TYPSAV
  99         ADD     FPTR,[7,,7]     ; ADJUST FOR FIRST STATUS WORDS
 100         PUSHJ   P,MARK2
 101         MOVEI   E,FPAG+6                ; SEND OUT PAIR
 102         PUSH    P,C             ; SAVE C
 103         MOVE    C,A
 104         PUSHJ   P,ADWD
 105         POP     P,C             ; RESTORE C
 106         MOVEI   E,FPAG+5
 107         MOVE    C,(C)           ; SEND OUT UPDATED PTR
 108         PUSHJ   P,ADWD
 109
 110         MOVEI   0,@BOTNEW       ; CALCULATE START OF TYPE-TABLE
 111         MOVEM   0,TYPTAB
 112         MOVE    0,RPURBT        ; RESTORE PURBOT
 113         MOVEM   0,PURBOT
 114         MOVE    0,RGCSTP        ; RESTORE GCSTOP
 115         MOVEM   0,GCSTOP
 116
 117
 118 ; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF
 119 ; THEM
 120
 121         MOVE    A,TYPSAV        ; GET AOBJN POINTER TO TYPE-VECTOR
 122         MOVEI   B,0             ; INITIALIZE TYPE COUNT
 123 TYPLP2: HLRE    C,(A)           ; GET MARKING
 124         JUMPGE  C,TYPLP1        ; IF NOT MARKED DON'T OUTPUT
 125         MOVE    C,(A)           ; GET FIRST WORD
 126         HRL     C,B             ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL
 127         PUSH    P,A
 128         SKIPL   FPTR
 129         PUSHJ   P,MOVFNT
 130         MOVEM   C,FRONT(FPTR)
 131         AOBJN   FPTR,.+2
 132         PUSHJ   P,MOVFNT        ; EXTEND THE FRONTIER
 133         POP     P,A
 134         MOVE    C,1(A)          ; OUTPUT SECOND WORD
 135         MOVEM   C,FRONT(FPTR)
 136         ADD     FPTR,[1,,1]
 137 TYPLP1: ADDI    B,1             ; INCREMENT TYPE COUNT
 138         ADD     A,[2,,2]        ; POINT TO NEXT SLOT
 139         JUMPL   A,TYPLP2        ; LOOP
 140
 141 ; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN
 142
 143         HRRZ    F,ABOTN
 144         MOVEI   0,@BOTNEW       ; GET CURRENT BEGINNING OF TRANSFER
 145         MOVEM   0,ABOTN         ; SAVE IT
 146         PUSHJ   P,ALLOGC        ; ALLOCATE ROOM FOR ATOMS
 147         MOVSI   D,400000        ; SET UP UNMARK BIT
 148 SPOUT:  JUMPE   LPVP,DPGC4      ; END OF CHAIN
 149         MOVEI   F,(LPVP)        ; GET COPY OF LPVP
 150         HRRZ    LPVP,-1(LPVP)   ; LPVP POINTS TO NEXT ON CHAIN
 151         ANDCAM  D,(F)           ; UNMARK IT
 152         HLRZ    C,(F)           ; GET LENGTH
 153         HRRZ    E,(F)           ; POINTER INTO INF
 154         ADD     E,ABOTN
 155         SUBI    C,2             ; WE'RE NOT SENDING OUT THE VALUE PAIR
 156         HRLM    C,(F)           ; ADJUSTED LENGTH
 157         MOVE    0,C             ; COPY C FOR TRBLKX
 158         SUBI    E,(C)           ; ADJUST PTRS FOR SENDOUT\r
 159         SUBI    F,-1(C)
 160         PUSHJ   P,TRBLKX        ; OUT IT GOES
 161         JRST    SPOUT
 162
 163
 164 ; HERE TO SEND OUT DELIMITER INFORMATION
 165 DPGC4:  SKIPN   INCORF          ; SKIP IF TRANSFREING TO UVECTOR IN CORE
 166         JRST    CONSTO
 167         SKIPL   FPTR            ; SEE IF ROOM IN FRONTEIR
 168         PUSHJ   P,MOVFNT        ; EXTEND FRONTEIR
 169         MOVSI   A,.VECT.
 170         MOVEM   A,FRONT(FPTR)
 171         AOBJN   FPTR,.+2
 172         PUSHJ   P,MOVFNT
 173         MOVEI   A,@BOTNEW       ; LENGTH
 174         SUBI    A,FPAG
 175         HRLM    A,FRONT(FPTR)
 176         ADD     FPTR,[1,,1]
 177
 178
 179 CONSTO: MOVEI   E,FPAG
 180         MOVE    C,ABOTN         ; START OF ATOMS
 181         SUBI    C,FPAG+CONADJ           ; ADJUSTMENT FOR STARTING ON PAGE ONE
 182         PUSHJ   P,ADWD          ; OUT IT GOES
 183         MOVEI   E,FPAG+1
 184         MOVEI   C,@BOTNEW
 185         SUBI    C,FPAG+CONADJ
 186         SKIPE   INCORF          ; SKIP IF TO CHANNEL
 187         SUBI    C,2             ; SUBTRACT FOR DOPE WORDS
 188         PUSHJ   P,ADWD
 189         SKIPE   INCORF
 190         ADDI    C,2             ; RESTORE C TO REAL ABOTN
 191         ADDI    C,CONADJ
 192         PUSH    P,C
 193         MOVE    C,TYPTAB
 194         SUBI    C,FPAG+CONADJ
 195         MOVEI   E,FPAG+2                ; SEND OUT START OF TYPE TABLE
 196         PUSHJ   P,ADWD
 197         ADDI    E,1             ; SEND OUT NUMPRI
 198         MOVEI   C,NUMPRI
 199         PUSHJ   P,ADWD
 200         ADDI    E,1             ; SEND OUT NUMSAT
 201         MOVEI   C,NUMSAT
 202         PUSHJ   P,ADWD
 203
 204
 205
 206 ; FINAL CLOSING OF INFERIORS
 207
 208 DPCLS:  PUSH    P,PGCNT
 209         PUSHJ   P,INFCL1
 210         POP     P,PGCNT
 211         POP     P,A             ; LENGTH OF CODE
 212
 213 ; RESTORE AC'S
 214         MOVE    PVP,PVSTOR+1
 215         IRP     AC,,[P,TP,TB,AB,FRM]
 216         MOVE    AC,AC!STO+1(PVP)
 217         TERMIN
 218
 219         SETZB   M,R
 220         SETZM   DUMFLG
 221         SETZM   GCDFLG          ; ZERO FLAG INDICATING IN DUMPER
 222         SETZM   GCFLG           ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON
 223         PUSH    P,A
 224         MOVE    A,INF2          ; GET POINTER TO PURE MAPPED OUT
 225         PUSHJ   P,%GBINT
 226
 227         POP     P,A
 228         JRST    EGCDUM
 229
 230
 231 ERDP:   PUSH    P,B
 232         PUSHJ   P,INFCLS
 233         PUSHJ   P,INFCL1
 234         SETZM   GCFLG
 235         SETZM   GPURFL          ; PURE FLAG
 236         SETZM   DUMFLG
 237         SETZM   GCDFLG
 238         POP     P,A
 239
 240 ; RESTORE AC'S
 241         MOVE    PVP,PVSTOR+1
 242         IRP     AC,,[P,R,M,TP,TB,AB,FRM]
 243         MOVE    AC,AC!STO+1(PVP)
 244         TERMIN
 245
 246 ERDUMP: PUSH    TP,$TATOM
 247
 248 OFFSET 0
 249
 250         PUSH    TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE
 251
 252 OFFSET OFFS
 253
 254         PUSH    TP,$TATOM               ; PUSH ON PRIMTYPE
 255         PUSH    TP,@STBL(A)             ; PUSH ON PRIMTYPE
 256         MOVEI   A,2
 257         JRST    ERRKIL
 258
 259 ; ALTERNATE ATOM MARKER FOR DUMPER
 260
 261 DATOMK: SKIPE   GPURFL          ; SKIP IF NOT IN PURIFIER
 262         JRST    PATOMK
 263         CAILE   A,0             ; SEE IF ALREADY MARKED
 264         JRST    GCRET
 265         PUSH    P,A             ; SAVE PTR TO ATOM
 266         HLRE    B,A             ; POINT TO DOPE WORD
 267         SUB     A,B             ; TO FIRST DOPE WORD
 268         MOVEI   A,1(A)          ; TO SECOND
 269         PUSH    P,A             ; SAVE PTR TO DOPE WORD
 270         HLRZ    B,(A)           ; GET LENGTH AND MARKING
 271         TRZE    B,400000        ; TURN OFF BIT AND SKIP IF UNMARKED
 272         JRST    DATMK1
 273         IORM    D,(A)           ; MARK IT
 274         MOVE    0,ABOTN         ; GET CURRENT TOP OF ATOM TABLE
 275         ADDI    0,-2(B)         ; PLACE OF DOPE WORD IN TABLE
 276         HRRM    0,(A)           ; PUT IN RELOCATION
 277         MOVEM   0,ABOTN         ; FIXUP TOP OF TABLE
 278         HRRM    LPVP,-1(A)      ; FIXUP CHAIN
 279         MOVEI   LPVP,(A)
 280         MOVE    A,-1(P)         ; GET POINTER TO ATOM BACK
 281         HRRZ    B,2(A)          ; GET OBLIST POINTER
 282         JUMPE   B,NOOB          ; IF ZERO ON NO OBLIST
 283         CAMG    B,VECBOT        ; DON'T SKIP IF OFFSET FROM TVP
 284         MOVE    B,(B)
 285         HRLI    B,-1
 286 DATMK3: MOVE    A,$TOBLS        ; SET UP FOR GET
 287         MOVE    C,$TATOM
 288
 289 OFFSET 0
 290         MOVE    D,IMQUOTE OBLIST
 291
 292 OFFSET OFFS
 293
 294         PUSH    P,TP            ; SAVE FPTR
 295         MOVE    TP,MAINPR
 296         MOVE    TP,TPSTO+1(TP)          ; GET TP
 297         PUSHJ   P,IGET
 298         POP     P,TP            ; RESTORE FPTR
 299         MOVE    C,-1(P)         ; RECOVER PTR TO ATOM
 300         ADDI    C,1             ; SET UP TO MARK OBLIST ATOM
 301         MOVSI   D,400000        ; RESTORE MARK WORD
 302
 303 OFFSET 0
 304
 305         CAMN    B,MQUOTE ROOT
 306
 307 OFFSET OFFS
 308
 309         JRST    RTSET
 310         MOVEM   B,1(C)
 311         MOVEI   B,TATOM
 312         PUSHJ   P,MARK1         ; MARK IT
 313         MOVEM   A,1(C)          ; SMASH IN ITS ID
 314 DATMK1:
 315 NOOB:   POP     P,A             ; GET PTR TO DOPE WORD BACK
 316         HRRZ    A,(A)           ; RETURN ID
 317         SUB     P,[1,,1]        ; CLEAN OFF STACK
 318         MOVEM   A,(P)
 319         JRST    GCRET           ; EXIT
 320
 321 ; HERE FOR A ROOT ATOM
 322 RTSET:  SETOM   1(C)            ; INDICATOR OF ROOT ATOM
 323         JRST    NOOB            ; CONTINUE
 324
 325 \f
 326 ; INTERNAL PURIFY ROUTINE
 327 ; SAVE AC's
 328
 329 IPURIF: PUSHJ   P,PURCLN                ; GET RID OF PURE MAPPED
 330         MOVE    PVP,PVSTOR+1
 331         IRP     AC,,[P,R,M,TP,TB,AB,FRM]
 332         MOVEM   AC,AC!STO"+1(PVP)
 333         TERMIN
 334
 335
 336 ; HERE TO CREATE INFERIORS AND MARK THE ITEM
 337 PURIT1: MOVE    PVP,PVSTOR+1
 338         MOVEM   P,PSTO+1(PVP)   ; SAVE P
 339         SETOM   GPURFL          ; INDICATE PURIFICATION IS TAKING PLACE
 340         MOVE    C,AB            ; ARG PAIR
 341         MOVEM   C,SAVRS1        ; SAV PTR TO PAIR
 342         MOVE    P,GCPDL
 343         PUSHJ   P,INFSUP        ; GET INFERIORS
 344         MOVE    P,A             ; GET NEW PDL PTR
 345         PUSHJ   P,%SAVRP        ; SAVE RPMAP TABLE FOR TENEX
 346         MOVE    C,SAVRS1        ; SET UP FOR MARKING
 347         MOVE    A,(C)   ; GET TYPE WORD
 348         MOVEM   A,SAVRE2
 349 PURIT3: PUSH    P,C
 350         PUSHJ   P,MARK2
 351 PURIT4: POP     P,C             ; RESTORE C
 352         ADD     C,[2,,2]        ; TO NEXT ARG
 353         JUMPL   C,PURIT3
 354         MOVEM   A,SAVRES        ; SAVE UPDATED POINTER
 355
 356 ; FIX UP IMPURE PART OF ATOM CHAIN
 357
 358         PUSH    P,[0]           ; FLAG INDICATING NON PURE SCAN
 359         PUSHJ   P,FIXATM
 360         SUB     P,[1,,1]        ; CLEAN OFF STACK
 361
 362 ; NOW TO GET PURE STORAGE
 363
 364 PURIT2: MOVEI   A,@BOTNEW       ; GET BOTNEW
 365         SUBI    A,2000-1777     ; START AT PAGE 1 AND ROUND
 366         ANDCMI  A,1777
 367         ASH     A,-10.          ; TO PAGES
 368         SETZ    M,
 369         PUSH    P,A
 370         PUSHJ   P,PGFIND        ; FIND THEM
 371         JUMPL   B,LOSLP2        ; LOST GO TO CAUSE AGC
 372         HRRZ    0,BUFGC                 ;GET BUFFER PAGE
 373         ASH     0,-10.
 374         MOVEI   A,(B)           ; GET LOWER PORTION OF PAGES
 375         MOVN    C,(P)
 376         SUBM    A,C             ; GET END PAGE
 377         CAIL    0,(A)           ; L? LOWER
 378         CAILE   0,(C)           ; G? HIGER
 379         JRST    NOREMP          ; DON'T GET NEW BUFFER
 380         PUSHJ   P,%FDBUF        ; GET A NEW BUFFER PAGE
 381 NOREMP: MOVN    A,(P)           ; SET UP AOBJN PTR FOR MAPIN
 382         MOVE    C,B             ; SAVE B
 383         HRL     B,A
 384         HRLZS   A
 385         ADDI    A,1
 386         MOVEM   B,INF3          ; SAVE PTR FOR PURIFICATION
 387         PUSHJ   P,%MPIN1        ; MAP IT INTO PURE
 388         ASH     C,10.           ; TO WORDS
 389         MOVEM   C,MAPUP
 390         SUB     P,[1,,1]        ; CLEAN OFF STACK
 391
 392 DONMAP:
 393 ; RESTORE AC's
 394         MOVE    PVP,PVSTOR+1
 395         MOVE    P,PSTO+1(PVP)           ; GET REAL P
 396         PUSH    P,LPVP
 397         MOVEI   A,@BOTNEW
 398         MOVEM   A,NABOTN
 399
 400         IRP     AC,,[M,TP,TB,R,FRM]
 401         MOVE    AC,AC!STO+1(PVP)
 402         TERMIN
 403         MOVE    A,INF1
 404
 405 ; NOW FIX UP POINTERS IN PURE STRUCTURE
 406         MOVE    0,GCSBOT
 407         MOVEM   0,OGCSTP
 408         PUSH    P,GCSBOT        ; SAVE GCSBOT AND GCSTOP
 409         PUSH    P,GCSTOP
 410         MOVE    A,MAPUP         ; NEW GCSBOT AND TOP TO FOOL GCHACK
 411         MOVEM   A,GCSBOT
 412         ADD     A,NABOTN
 413         SUBI    A,2000          ; ADJUSTMENT FOR START ON PAGE ONE
 414         MOVEM   A,GCSTOP
 415         MOVE    A,[PUSHJ P,NPRFIX]
 416         MOVEI   PVP,0           ; SAY MIGHT BE NON-ATOMS
 417         PUSHJ   P,GCHK10
 418         POP     P,GCSTOP
 419         POP     P,GCSBOT
 420
 421 ; NOW FIX UP POINTERS TO PURIFIED STRUCTURE
 422
 423         MOVE    A,[PUSHJ P,PURFIX]
 424         MOVEI   PVP,0           ; SAY MIGHT BE NON-ATOMS
 425         PUSHJ   P,GCHACK
 426
 427         SETZM   GCDFLG
 428         SETZM   DUMFLG
 429         SETZM   GCFLG
 430
 431         POP     P,LPVP          ; GET BACK LPVP
 432         MOVE    A,INF1
 433         PUSHJ   P,%KILJB        ; KILL IMAGE SAVING INFERIOR
 434         PUSH    P,[-1]          ; INDICATION OF PURE ATOM SCAN
 435         PUSHJ   P,FIXATM
 436
 437 ; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED
 438
 439         MOVE    A,INF3          ; GET AOBJN PTR TO PAGES
 440 FIXPMP: HRRZ    B,A             ; GET A PAGE
 441         IDIVI   B,16.           ; DIVIDE SO AS TO PT TO PMAP WORD
 442         PUSHJ   P,PINIT         ; SET UP PARAMETER
 443         LSH     D,-1
 444         TDO     E,D             ; FIX UP WORD
 445         MOVEM   E,PMAPB(B)      ; SEND IT BACK
 446         AOBJN   A,FIXPMP
 447
 448         SUB     P,[1,,1]
 449         MOVE    A,[PUSHJ P,PURTFX]      ; FIX UP PURE ATOM POINTERS
 450         MOVEI   PVP,1           ; SAY MIGHT BE NON-ATOMS
 451         PUSHJ   P,GCHACK
 452
 453 ; NOW FIX UP POINTERS IN PURE STRUCTURE
 454         PUSH    P,GCSBOT        ; SAVE GCSBOT AND GCSTOP
 455         PUSH    P,GCSTOP
 456         MOVE    A,MAPUP         ; NEW GCSBOT AND TOP TO FOOL GCHACK
 457         MOVEM   A,GCSBOT
 458         ADD     A,NABOTN
 459         SUBI    A,2000          ; ADJUSTMENT FOR START ON PAGE ONE
 460         MOVEM   A,GCSTOP
 461         MOVE    A,[PUSHJ P,PURTFX]
 462         MOVEI   PVP,1           ; SAY MIGHT BE NON-ATOMS
 463         PUSHJ   P,GCHK10
 464         POP     P,GCSTOP
 465         POP     P,GCSBOT
 466
 467 ; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD
 468
 469         MOVE    A,TYPVEC+1      ; GET TYPE VECTOR
 470         MOVEI   B,400000        ; TLOSE==0
 471 TTFIX:  HRRZ    D,1(A)          ; GET ADDR
 472         HLRE    C,1(A)
 473         SUB     D,C
 474         HRRM    B,(D)           ; SMASH IT IN
 475 NOTFIX: ADDI    B,1             ; NEXT TYPE
 476         ADD     A,[2,,2]
 477         JUMPL   A,TTFIX
 478
 479 ; NOW CLOSE UP INFERIORS AND RETURN
 480
 481 PURCLS: MOVE    P,[-2000,,MRKPDL]
 482         PUSHJ   P,%RSTRP        ;RESETORE RPMAP TABLE FOR TENEX
 483         PUSHJ   P,INFCLS
 484
 485         MOVE    PVP,PVSTOR+1
 486         MOVE    P,PSTO+1(PVP)   ; RESTORE P
 487         MOVE    AB,ABSTO+1(PVP) ; RESTORE R
 488
 489         MOVE    A,INF3          ; GET PTR TO PURIFIED STRUCTURE
 490         SKIPN   NPRFLG
 491         PUSHJ   P,%PURIF        ;  PURIFY
 492
 493         SETZM   GPURFL
 494         JRST    EPURIF          ; FINISH UP
 495
 496 NPRFIX: PUSH    P,A
 497         PUSH    P,B
 498         PUSH    P,C
 499         EXCH    A,C
 500         PUSHJ   P,SAT           ; GET STORAGE ALLOCATION TYPE
 501         MOVE    C,MAPUP         ; FIXUP AMOUNT
 502         SUBI    C,FPAG          ; ADJUST FOR START ON FIRST PAGE
 503         CAIE    A,SLOCR         ; DONT HACK TLOCRS
 504         CAIN    A,S1WORD        ; SKIP IF NOT OF PRIMTYPE WORD
 505         JRST    LSTFXP
 506         CAIN    A,SATOM
 507         JRST    ATMFXP
 508         CAIN    A,SOFFS
 509          JRST   OFFFXP          ; FIXUP OFFSETS
 510         HRRZ    D,1(B)
 511         JUMPE   D,LSTFXP        ; SKIP IF NIL
 512         CAMG    D,PURTOP        ; SEE IF ALREADY PURE
 513         ADDM    C,1(B)
 514 LSTFXP: TLNN    B,.LIST.        ; SKIP IF NOT A PAIR
 515         JRST    LSTEX1
 516         HRRZ    D,(B)           ; GET REST OF LIST
 517         SKIPE   D               ; SKIP IF POINTS TO NIL
 518         PUSHJ   P,RLISTQ
 519         JRST    LSTEX1
 520         CAMG    D,PURTOP        ; SKIP IF ALREADY PURE
 521         ADDM    C,(B)           ; FIX UP LIST
 522 LSTEX1: POP     P,C
 523         POP     P,B             ; RESTORE GCHACK AC'S
 524         POP     P,A
 525         POPJ    P,
 526
 527 OFFFXP: HLRZ    0,D             ; POINT TO LIST
 528         JUMPE   0,LSTFXP        ; POINTS TO NIL
 529         CAML    0,PURTOP        ; ALREADY PURE?
 530          JRST   LSTFXP          ; YES
 531         ADD     0,C             ; UPDATE THE POINTER
 532         HRLM    0,1(B)          ; STUFF IT OUT
 533         JRST    LSTFXP          ; DONE
 534
 535 ATMFXP: HLRE    0,D             ; GET LENGTH
 536         SUB     D,0             ; POINT TO FIRST DOPE WORD
 537         HRRZS   D
 538         CAML    D,OGCSTP
 539         CAIL    D,HIBOT         ; SKIP IF IMPURE
 540         JRST    LSTFXP
 541         HRRZ    0,1(D)          ; GET RELOCATION
 542         SUBI    0,1(D)
 543         ADDM    0,1(B)          ; FIX UP PTR IN STRUCTURE
 544         JRST    LSTFXP
 545
 546 ; FIXUP OF PURE ATOM POINTERS
 547
 548 PURTFX: CAIE    C,TATOM         ; SKIP IF ATOM POINTER
 549         POPJ    P,
 550         HLRE    E,D             ; GET TO DOPE WORD
 551         SUBM    D,E
 552         SKIPL   1(E)            ; SKIP IF MARKED
 553         POPJ    P,
 554         HRRZ    0,1(E)          ; RELATAVIZE PTR
 555         SUBI    0,1(E)
 556         ADD     D,0             ; FIX UP PASSED POINTER
 557         SKIPE   B               ; AND IF APPROPRIATE MUNG POINTER
 558         ADDM    0,1(B)          ; FIX UP POINTER
 559         POPJ    P,
 560
 561 PURFIX: PUSH    P,D
 562         PUSH    P,A
 563         PUSH    P,B
 564         PUSH    P,C             ; SAVE AC'S FOR GCHACK
 565         EXCH    A,C             ; GET TYPE IN A
 566         CAIN    A,TATOM         ; CHECK FOR ATOM
 567         JRST    ATPFX
 568         PUSHJ   P,SAT
 569
 570         CAILE   A,NUMSAT        ; SKIP IF TEMPLATE
 571         JRST    TLFX
 572 IFN ITS,        JRST    @PURDSP(A)
 573 IFE ITS,[
 574         HRRZ    0,PURDSP(A)
 575         HRLI    0,400000
 576         JRST    @0
 577 ]
 578 PURDSP:
 579
 580 OFFSET 0
 581
 582 DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX],
 583 [S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX]
 584 [SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]]
 585
 586 OFFSET OFFS
 587
 588 VECFX:  HLRE    0,D             ; GET LENGTH
 589         SUB     D,0             ; POINT TO D.W.
 590         SKIPL   1(D)            ; SKIP IF MARKED
 591         JRST    TLFX
 592         HRRZ    C,1(D)
 593         SUBI    C,1(D)          ; CALCULATE RELOCATION
 594         ADD     C,MAPUP         ; ADJUSTMENT
 595         SUBI    C,FPAG
 596         ADDM    C,1(B)
 597 TLFX:   TLNN    B,.LIST.        ; SEE IF PAIR
 598         JRST    LVPUR           ; LEAVE IF NOT
 599         PUSHJ   P,RLISTQ
 600         JRST    LVPUR
 601         HRRZ    D,(B)           ; GET CDR
 602         SKIPN   D               ; SKIP IF NOT ZERO
 603         JRST    LVPUR
 604         MOVE    D,(D)           ; GET CADR
 605         SKIPL   D               ; SKIP IF MARKED
 606         JRST    LVPUR
 607         ADD     D,MAPUP
 608         SUBI    D,FPAG
 609         HRRM    D,(B)           ; FIX UP
 610 LVPUR:  POP     P,C
 611         POP     P,B
 612         POP     P,A
 613         POP     P,D
 614         POPJ    P,
 615
 616 STRFX:  MOVE    C,B             ; GET ARG FOR BYTDOP
 617         PUSHJ   P,BYTDOP
 618         SKIPL   (A)             ; SKIP IF MARKED
 619         JRST    TLFX
 620         HRRZ    0,(A)           ; GET PTR IN NEW STRUCTURE
 621         SUBI    0,(A)           ; RELATAVIZE
 622         ADD     0,MAPUP         ; ADJUST
 623         SUBI    0,FPAG
 624         ADDM    0,1(B)          ; FIX UP PTR
 625         JRST    TLFX
 626
 627 ATPFX:  HLRE    C,D
 628         SUBM    D,C
 629         SKIPL   1(C)            ; SKIP IF MARKED
 630         JRST    TLFX
 631         HRRZS   C               ; SEE IF PURE
 632         CAIL    C,HIBOT         ; SKIP IF NOT PURE
 633         JRST    TLFX
 634         HRRZ    0,1(C)          ; GET PTR TO NEW ATOM
 635         SUBI    0,1(C)          ; RELATAVIZE
 636         ADD     D,0
 637         JUMPE   B,TLFX
 638         ADDM    0,1(B)          ; FIX UP
 639         JRST    TLFX
 640
 641 LPLSTF: SKIPN   D               ; SKIP IF NOT PTR TO NIL
 642         JRST    TLFX
 643         SKIPL   (D)             ; SKIP IF MARKED
 644         JRST    TLFX
 645         HRRZ    D,(D)           ; GET UPDATED POINTER
 646         ADD     D,MAPUP         ; ADJUSTMENT
 647         SUBI    D,FPAG
 648         HRRM    D,1(B)
 649         JRST    TLFX
 650
 651 OFFSFX: HLRZS   D               ; LIST POINTER
 652         JUMPE   D,TLFX          ; NIL
 653         SKIPL   (D)             ; MARKED?
 654          JRST   TLFX            ; NO
 655         ADD     D,MAPUP
 656         SUBI    D,FPAG          ; ADJUST
 657         HRLM    D,1(B)
 658         JRST    TLFX            ; RETURN
 659
 660 ; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL
 661
 662 LOSLP1: MOVE    A,ABOTN
 663         MOVEM   A,PARNEW        ; SET UP GC PARAMS
 664         MOVE    C,[12.,,6]
 665         JRST    PURLOS
 666
 667 LOSLP2: MOVEI   A,@BOTNEW       ; TOTAL AMOUNT NEEDED
 668         ADDI    A,1777
 669         ANDCMI  A,1777          ; CALCULATE PURE PAGES NEEDED
 670         MOVEM   A,GCDOWN
 671         MOVE    C,[12.,,8.]
 672         JRST    PURLOS
 673
 674 PURLOS: MOVE    P,[-2000,,MRKPDL]
 675         PUSH    P,GCDOWN
 676         PUSH    P,PARNEW
 677         MOVE    R,C             ; GET A COPY OF A
 678         PUSHJ   P,INFCLS        ; CLOSE INFERIORS AND FIX UP WORLD
 679         PUSHJ   P,INFCL2
 680 PURLS1: POP     P,PARNEW
 681         POP     P,GCDOWN
 682         MOVE    C,R
 683
 684 ; RESTORE AC'S
 685         MOVE    PVP,PVSTOR+1
 686         IRP     AC,,[P,R,M,TP,TB,AB,FRM]
 687         MOVE    AC,AC!STO+1(PVP)
 688         TERMIN
 689
 690         SETZM   GCDFLG          ; ZERO OUT FLAGS
 691         SETZM   DUMFLG
 692         SETZM   GPURFL
 693         SETZM   GCDANG
 694
 695         PUSHJ   P,AGC           ; GARBAGE COLLECT
 696         JRST    PURIT1          ; TRY AGAIN
 697
 698 ; PURIFIER ATOM MARKER
 699
 700 PATOMK: HRRZ    0,A
 701         CAMG    0,PARBOT
 702         JRST    GCRET           ; DONE IF FROZEN
 703         HLRE    B,A             ; GET TO D.W.
 704         SUB     A,B
 705         SKIPG   1(A)            ; SKIP IF NOT MARKED
 706         JRST    GCRET
 707         HLRZ    B,1(A)
 708         IORM    D,1(A)          ; MARK THE ATOM
 709         ADDM    B,ABOTN
 710         HRRM    LPVP,(A)        ; LINK ONTO CHAIN
 711         MOVEI   LPVP,1(A)
 712         JRST    GCRET           ; EXIT
 713
 714 \f
 715 .GLOBAL %LDRDO,%MPRDO
 716
 717 ; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES.
 718
 719 ; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE
 720 ; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING
 721
 722 ; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD
 723 ; INFERIOR IN READ/EXEC MODE
 724
 725 REPURE: PUSH    P,[PUSHJ P,%LDRDO]      ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF
 726         SKIPA
 727 PROPUR: PUSH    P,[PUSHJ P,%MPRDO]      ; INSTRUCTION FOR MAPPING PAGES TO AGD INF
 728         MOVE    A,PURBOT                ; GET STARTING PAGE OF PURENESS
 729         ASH     A,-10.                  ; CONVERT TO PAGES
 730         MOVEI   C,HIBOT                 ; GET ENDING PAGE
 731         ASH     C,-10.                  ; CONVERT TO PAGES
 732         PUSH    P,A                     ; SAVE PAGE POINTER
 733         PUSH    P,C                     ; SAVE END OF PURENESS POINTER
 734 PROLOP: CAML    A,(P)                   ; SKIP IF STILL PURE PAGES TO CHECK
 735         JRST    PRODON                  ; DONE MAPPING PAGES
 736         PUSHJ   P,CHKPGI                ; SKIP IF PAGE IS PURE
 737         JRST    NOTPUR                  ; IT IS NOT
 738         MOVE    A,-1(P)                 ; GET PAGE TO MAP
 739         XCT     -2(P)                   ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE
 740 NOTPUR: AOS     A,-1(P)                 ; INCREMENT PAGE POINTER AND LOAD
 741         JRST    PROLOP                  ; LOOP BACK
 742 PRODON: SUB     P,[3,,3]                ; CLEAN OFF STACK
 743         POPJ    P,                      ; EXIT
 744
 745
 746 \f
 747 .GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1
 748 .GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF
 749 INFSU1: PUSH    P,[-1]          ; ENTRY USED BY GC-DUMP
 750         SKIPA
 751 INFSUP: PUSH    P,[0]
 752         MOVE    A,GLOTOP+1              ; GET GLOTOP FOR LOCR HACKS
 753         MOVEM   A,GLTOP
 754         PUSHJ   P,%FDBUF        ; GET A BUFFER FOR C/W HACKS
 755         SETOM   GCDFLG
 756         SETOM   GCFLG
 757         HLLZS   SQUPNT
 758         HRRZ    TYPNT,TYPVEC+1  ; SETUP TYPNT
 759         HRLI    TYPNT,B
 760         MOVEI   A,STOSTR
 761         ANDCMI  A,1777          ; TO PAGE BOUNDRY
 762         SUB     A,GCSTOP        ; SET UP AOBJN POINTER FOR C/W HACK
 763         ASH     A,-10.          ; TO PAGES
 764         HRLZS   A
 765         MOVEI   B,STOSTR        ; GET START OF MAPPING
 766         ASH     B,-10.
 767         ADDI    A,(B)
 768         MOVEM   A,INF1
 769         PUSHJ   P,%SAVIN        ; PROTECT THE CORE IMAGE
 770         SKIPGE  (P)             ; IF < 0 GC-DUMP CALL
 771         PUSHJ   P,PROPUR        ; PROTECT PURE PAGES
 772         SUB     P,[1,,1]        ; CLEAN OFF PSTACK
 773         PUSHJ   P,%CLSJB        ; CLOSE INFERIOR
 774
 775         MOVSI   D,400000        ; CREATE MARK WORD
 776         SETZB   LPVP,ABOTN      ; ZERO ATOM COUNTER
 777         MOVEI   A,2000          ; MARKED INF STARTS AT PAGE ONE
 778         HRRM    A,BOTNEW
 779         SETZM   WNDBOT
 780         SETZM   WNDTOP
 781         HRRZM   A,FNTBOT
 782         ADDI    A,2000          ; WNDTOP
 783         MOVEI   A,1             ; TO PAGES
 784         PUSHJ   P,%GCJB1        ; CREATE THE JOB
 785         MOVSI   FPTR,-2000
 786         MOVEI   A,LPUR          ; SAVE THE PURE CORE IMAGE
 787         ANDCMI  A,1777          ; TO PAGE BOUNDRY
 788         MOVE    0,A             ; COPY TO 0
 789         ASH     0,-10.          ; TO PAGES
 790         SUB     A,HITOP         ; SUBTRACT TOP OF CORE
 791         ASH     A,-10.
 792         HRLZS   A
 793         ADD     A,0
 794         MOVEM   A,INF2
 795         PUSHJ   P,%IMSV1        ; MAP OUT INTERPRETER
 796         PUSHJ   P,%OPGFX
 797
 798 ; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS
 799
 800         MOVE    A,[-2000,,MRKPDL]
 801         POPJ    P,
 802
 803 ; ROUTINE TO CLOSE GC's INFERIOR
 804
 805
 806 INFCLS: MOVE    A,INF2          ; GET POINTER TO PURE MAPPED OUT
 807         PUSHJ   P,%CLSMP
 808         POPJ    P,
 809
 810 ; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP
 811
 812 INFCL2: PUSHJ   P,%IFMP1        ; OPEN AGD INF TO RESTORE PAGES
 813 INFCL3: MOVE    A,INF1          ; RESTORE OPENING POINTER
 814         PUSH    P,INF2
 815         MOVE    B,A             ; SATIFY MUDITS
 816         PUSHJ   P,%IFMP2        ; MAP IN GC PAGES AND CLOSE INFERIOR
 817         POP     P,INF2          ; RESTOR INF2 PARAMETER
 818         POPJ    P,
 819
 820 INFCL1: PUSHJ   P,%IFMP1        ; OPEN AGD INF TO RESTORE PAGES
 821         SKIPGE  PURMNG          ; SKIP IF NO PURE PAGES WERE MUNGED
 822         PUSHJ   P,REPURE        ; REPURIFY MUNGED PAGES
 823         JRST    INFCL3
 824
 825 \f
 826
 827 ; ROUTINE TO DO TYPE HACKING FOR GC-DUMP.  IT MARKS THE TYPE-WORD OF THE
 828 ; SLOT IN THE TYPE VECTOR.  IT ALSO MARKS THE ATOM REPLACING THE I.D. IN
 829 ; THE RIGHT HALF OF THE ATOM SLOT.  IF THE TYPE IS A TEMPLATE THE FIRST
 830 ; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT
 831 ; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE).
 832
 833 TYPHK:  CAILE   B,NUMPRI        ; SKIP IF A MUDDLE TYPE
 834         JRST    TYPHKR          ; ITS A NEWTYPE SO GO TO TYPHACKER
 835         CAIN    B,TTYPEC        ; SKIP IF NOT TYPE-C
 836         JRST    TYPCHK          ; GO TO HACK TYPE-C
 837         CAIE    B,TTYPEW        ; SKIP IF TYPE-W
 838         POPJ    P,
 839         PUSH    P,B
 840         HLRZ    B,A             ; GET TYPE
 841         JRST    TYPHKA          ; GO TO TYPE-HACKER
 842 TYPCHK: PUSH    P,B             ; SAVE TYPE-WORD
 843         HRRZ    B,A
 844         JRST    TYPHKA
 845
 846 ; GENERAL TYPE-HACKER FOR GC-DUMP
 847
 848 TYPHKR: PUSH    P,B             ; SAVE AC'S
 849 TYPHKA: PUSH    P,A
 850         PUSH    P,C
 851         LSH     B,1             ; GET OFFSET TO SLOT IN TYPE VECTOR
 852         MOVEI   C,(TYPNT)       ; GET TO SLOT
 853         ADDI    C,(B)
 854         SKIPGE  (C)
 855         JRST    EXTYP
 856         IORM    D,(C)           ; MARK THE SLOT
 857         MOVEI   B,TATOM         ; NOW MARK THE ATOM SLOT
 858         PUSHJ   P,MARK1         ; MARK IT
 859         HRRM    A,1(C)          ; SMASH IN ID
 860         HRRZS   1(C)            ; MAKE SURE THAT THATS ALL THATS THERE
 861         HRRZ    B,(C)           ; GET SAT
 862         ANDI    B,SATMSK        ; GET RID OF MAGIC BITS
 863         HRRM    B,(C)           ; SMASH SAT BACK IN
 864         CAIG    B,NUMSAT        ; SKIP IF TEMPLATE
 865         JRST    EXTYP
 866         MOVE    A,TYPSAV        ; GET POINTER TO TYPE VECTOR
 867         ADDI    A,NUMPRI*2              ; GET TO NEWTYPES SLOTS
 868         HRLI    0,NUMPRI*2
 869         HLLZS   0               ; MAKE SURE ONLY LEFT HALF
 870         ADD     A,0
 871 TYPHK1: HRRZ    E,(A)           ; GET SAT OF SLOT
 872         CAMN    E,B             ; SKIP IF NOT EQUAL
 873         JRST    TYPHK2          ; GOT IT
 874         ADDI    A,2             ; TO NEXT
 875         JRST    TYPHK1
 876 TYPHK2: PUSH    P,C             ; SAVE POINTER TO ORIGINAL SLOT
 877         MOVE    C,A             ; COPY A
 878         MOVEI   B,TATOM         ; SET UP FOR MARK
 879         MOVE    A,1(C)          ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE
 880         SKIPL   (C)             ; DON'T MARK IF ALREADY MARKED
 881         PUSHJ   P,MARK
 882         POP     P,C             ; RESTORE C
 883         HRLM    A,1(C)          ; SMASH IN PRIMTYPE OF TEMPLATE
 884 EXTYP:  POP     P,C             ; RESTORE AC'S
 885         POP     P,A
 886         POP     P,B
 887         POPJ    P,              ; EXIT
 888
 889
 890 ; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER
 891 RLISTQ: PUSH    P,A
 892         GETYP   A,(B)           ; GET TYPE
 893         PUSHJ   P,SAT           ; GET SAT
 894         CAIG    A,NUMSAT        ; NOT DEFERRED IF TEMPLATE
 895         SKIPL   MKTBS(A)
 896         AOS     -1(P)           ; SKIP IF NOT DEFFERED
 897         POP     P,A
 898         POPJ    P,              ; EXIT
 899
 900
 901 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
 902
 903 GCDISP:
 904
 905 OFFSET 0
 906
 907 DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP]
 908 [STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK]
 909 [SFRAME,ERDP],[SBYTE,<SETZ BYTMK>],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP]
 910 [SLOCID,ERDP],[SCHSTR,<SETZ BYTMK>],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP]
 911 [SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ERDP]
 912 [SLOCB,<SETZ BYTMK>],[SLOCR,LOCRDP],[SOFFS,OFFSMK]]
 913
 914 OFFSET OFFS
 915
 916 \f
 917 ; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS
 918
 919 IMPRF:  PUSH    P,A
 920         PUSH    P,LPVP
 921         PUSH    TP,$TATOM
 922         HLRZ    C,(A)           ; GET LENGTH
 923         TRZ     C,400000        ; TURN OF 400000 BIT
 924         SUBI    A,-1(C)         ; POINT TO START OF ATOM
 925         MOVNI   C,-2(C)         ; MAKE IT LOOK LIKE AN ATOM POINTER
 926         HRL     A,C
 927         PUSH    TP,A
 928         MOVE    C,A
 929         MOVEI   0,(C)
 930         PUSH    P,AB
 931         MOVE    PVP,PVSTOR+1
 932         MOVE    AB,ABSTO+1(PVP)
 933         PUSHJ   P,IMPURX
 934         POP     P,AB
 935         POP     P,LPVP          ; RESTORE A
 936         POP     P,A
 937         POPJ    P,
 938
 939 FIXATM: PUSH    P,[0]
 940 FIXTM5: JUMPE   LPVP,FIXTM4
 941         MOVEI   B,(LPVP)        ; GET PTR TO ATOMS DOPE WORD
 942         HRRZ    LPVP,-1(B)      ; SET UP LPVP FOR NEXT IN CHAIN
 943         SKIPE   -2(P)           ; SEE IF PURE SCAN
 944         JRST    FIXTM2
 945         CAIL    B,HIBOT
 946         JRST    FIXTM3
 947 FIXTM2: CAMG    B,PARBOT        ; SKIP IF NOT FROZEN
 948         JRST    FIXTM1
 949         HLRZ    A,(B)
 950         TRZ     A,400000        ; GET RID OF MARK BIT
 951         MOVE    D,A             ; GET A COPY OF LENGTH
 952         SKIPE   -2(P)
 953         JRST    PFATM
 954         PUSHJ   P,CAFREE        ; GET STORAGE
 955         SKIPE   GCDANG          ; SEE IF WON
 956         JRST    LOSLP1          ; GO TO CAUSE GC
 957         JRST    FIXT10
 958 PFATM:  PUSH    P,AB
 959         MOVE    PVP,PVSTOR+1
 960         MOVE    AB,ABSTO+1(PVP)
 961         SETZM   GPURFL
 962         PUSHJ   P,CAFREE
 963         SETOM   GPURFL
 964         POP     P,AB
 965 FIXT10: SUBM    D,ABOTN
 966         MOVNS   ABOTN
 967         SUBI    B,-1(D)         ; POINT TO START OF ATOM
 968         HRLZ    C,B             ; SET UP FOR BLT
 969         HRRI    C,(A)
 970         ADDI    A,-1(D)         ; FIX UP TO POINT TO NEW DOPE WORD
 971         BLT     C,(A)
 972         HLLZS   -1(A)
 973         HLLOS   (A)             ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE
 974         ADDI    B,-1(D)         ; B POINTS TO SECOND D.W.
 975         HRRM    A,(B)           ; PUT IN RELOCATION
 976         MOVSI   D,400000        ; UNMARK ATOM
 977         ANDCAM  D,(A)
 978         CAIL    B,HIBOT         ; SKIP IF IMPURE
 979         PUSHJ   P,IMPRF
 980         JRST    FIXTM5          ; CONTINE FIXUP
 981
 982 FIXTM4: POP     P,LPVP          ; FIX UP LPVP TO POINT TO NEW CHAIN
 983         POPJ    P,              ; EXIT
 984
 985 FIXTM1: HRRM    B,(B)           ; SMASH IN RELOCATION
 986         MOVSI   D,400000
 987         ANDCAM  D,(B)           ; CLEAR MARK BIT
 988         JRST    FIXTM5
 989
 990 FIXTM3: MOVE    0,(P)
 991         HRRM    0,-1(B)
 992         MOVEM   B,(P)   ; FIX UP CHAIN
 993         JRST    FIXTM5
 994
 995
 996 \f
 997 IAGC":
 998
 999 ;SET FLAG FOR INTERRUPT HANDLER
1000         SETZB   M,RCL           ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR
1001         EXCH    P,GCPDL         ; IN CASE CURRENT PDL LOSES
1002         PUSH    P,B
1003         PUSH    P,A
1004         PUSH    P,C             ; SAVE C
1005
1006 ; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING
1007
1008
1009
1010         MOVE    A,NOWFRE
1011         ADD     A,GCSTOP        ; ADJUSTMENT TO KEEP FREE REAL
1012         SUB     A,FRETOP
1013         MOVEM   A,NOWFRE
1014         MOVE    A,NOWP          ; ADJUSTMENTS FOR STACKS
1015         SUB     A,CURP
1016         MOVEM   A,NOWP
1017         MOVE    A,NOWTP
1018         SUB     A,CURTP
1019         MOVEM   A,NOWTP
1020
1021         MOVEI   B,[ASCIZ /GIN /]
1022         SKIPE   GCMONF          ; MONITORING
1023         PUSHJ   P,MSGTYP
1024 NOMON1: HRRZ    C,(P)           ; GET CAUSE OF GC INDICATOR
1025         MOVE    B,GCNO(C)       ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON
1026         ADDI    B,1
1027         MOVEM   B,GCNO(C)
1028         MOVEM   C,GCCAUS        ; SAVE CAUSE OF GC
1029         SKIPN   GCMONF          ; MONITORING
1030         JRST    NOMON2
1031         MOVE    B,MSGGCT(C)     ; GET CAUSE MESSAGE
1032         PUSHJ   P,MSGTYP
1033 NOMON2: HLRZ    C,(P)           ; FIND OUT WHO CAUSED THE GC
1034         MOVEM   C,GCCALL        ; SAVE CALLER OF GC
1035         SKIPN   GCMONF          ; MONITORING
1036         JRST    NOMON3
1037         MOVE    B,MSGGFT(C)
1038         PUSHJ   P,MSGTYP
1039 NOMON3: SUB     P,[1,,1]        ; POP OFF C
1040         POP     P,A
1041         POP     P,B
1042         EXCH    P,GCPDL
1043         JRST    .+1
1044 IAAGC:
1045         HLLZS   SQUPNT          ; FLUSH SQUOZE TABLE
1046         SETZB   M,RCL           ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION
1047 INITGC: SETOM   GCFLG
1048         SETZM   RCLV
1049
1050 ;SAVE AC'S
1051         EXCH    PVP,PVSTOR+1
1052         IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
1053         MOVEM   AC,AC!STO"+1(PVP)
1054         TERMIN
1055
1056         MOVE    0,PVSTOR+1
1057         MOVEM   0,PVPSTO+1(PVP)
1058         MOVEM   PVP,PVSTOR+1
1059         MOVE    D,DSTORE
1060         MOVEM   D,DSTO(PVP)
1061         JSP     E,CKPUR         ; CHECK FOR PURE RSUBR
1062
1063
1064 ;SET UP E TO POINT TO TYPE VECTOR
1065         GETYP   E,TYPVEC
1066         CAIE    E,TVEC
1067         JRST    AGCE1
1068         HRRZ    TYPNT,TYPVEC+1
1069         HRLI    TYPNT,B
1070
1071 CHPDL:  MOVE    D,P             ; SAVE FOR LATER
1072 CORGET: MOVE    P,[-2000,,MRKPDL]
1073
1074 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
1075
1076         MOVEI   A,(TB)          ;POINT TO CURRENT FRAME IN PROCESS
1077         PUSHJ   P,FRMUNG        ;AND MUNG IT
1078         MOVE    A,TP            ;THEN TEMPORARY PDL
1079         PUSHJ   P,PDLCHK
1080         MOVE    PVP,PVSTOR+1
1081         MOVE    A,PSTO+1(PVP)   ;AND UNMARKED P STACK
1082         PUSHJ   P,PDLCHP
1083
1084 \f; FIRST CREATE INFERIOR TO HOLD NEW PAGES
1085
1086 INFCRT: MOVE    A,PARBOT        ; GENERATE NEW PARBOT AND PARNEW
1087         ADD     A,PARNEW
1088         ADDI    A,1777
1089         ANDCMI  A,1777          ; EVEN PAGE BOUNDARY
1090         HRRM    A,BOTNEW        ; INTO POINTER WORD
1091         HRRZM   A,FNTBOT
1092         SETZM   WNDBOT
1093         SETZM   WNDTOP
1094         MOVEM   A,NPARBO
1095         HRRZ    A,BOTNEW        ; GET PAGE TO START INF AT
1096         ASH     A,-10.          ; TO PAGES
1097         MOVEI   R,(A)           ; COPY A
1098         PUSHJ   P,%GCJOB        ; GET PAGE HOLDER
1099         MOVSI   FPTR,-2000      ; FIX UP FRONTIER POINTER
1100         MOVE    A,WNDBOT
1101         ADDI    A,2000          ; FIND WNDTOP
1102         MOVEM   A,WNDTOP
1103
1104 ;MARK PHASE: MARK ALL LISTS AND VECTORS
1105 ;POINTED TO WITH ONE BIT IN SIGN BIT
1106 ;START AT TRANSFER VECTOR
1107 NOMAP:  MOVE    A,GLOBSP+1              ; GET GLOBSP TO SAVE
1108         MOVEM   A,GCGBSP
1109         MOVE    A,ASOVEC+1      ; ALSO SAVE FOR USE BY GC
1110         MOVEM   A,GCASOV
1111         MOVE    A,NODES+1       ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE
1112         MOVEM   A,GCNOD
1113         MOVE    A,GLOTOP+1              ; GET GLOTOP FOR LOCR HACKS
1114         MOVEM   A,GLTOP
1115         MOVE    A,PURVEC+1              ; SAVE PURE VECTOR FOR GETPAG
1116         MOVEM   A,PURSVT
1117         MOVE    A,HASHTB+1
1118         MOVEM   A,GCHSHT
1119
1120         SETZ    LPVP,           ;CLEAR NUMBER OF PAIRS
1121         MOVE    0,NGCS          ; SEE IF NEED HAIR
1122         SOSGE   GCHAIR
1123         MOVEM   0,GCHAIR        ; RESUME COUNTING
1124         MOVSI   D,400000        ;SIGN BIT FOR MARKING
1125         MOVE    A,ASOVEC+1      ;MARK ASSOC. VECTOR NOW
1126         PUSHJ   P,PRMRK         ; PRE-MARK
1127         MOVE    A,GLOBSP+1
1128         PUSHJ   P,PRMRK
1129         MOVE    A,HASHTB+1
1130         PUSHJ   P,PRMRK
1131 OFFSET 0
1132
1133         MOVE    A,IMQUOTE THIS-PROCESS
1134
1135 OFFSET OFFS
1136
1137         MOVEM   A,GCATM
1138
1139 ; HAIR TO DO AUTO CHANNEL CLOSE
1140
1141         MOVEI   0,N.CHNS-1      ; NUMBER OF CHANNELS
1142         MOVEI   A,CHNL1 ; 1ST SLOT
1143
1144         SKIPE   1(A)            ; NOW A CHANNEL?
1145         SETZM   (A)             ; DON'T MARK AS CHANNELS
1146         ADDI    A,2
1147         SOJG    0,.-3
1148
1149         MOVEI   C,PVSTOR
1150         MOVEI   B,TPVP
1151         MOVE    A,PVSTOR+1      ; MARK MAIN PROCES EVEN IF SWAPPED OUT
1152         PUSHJ   P,MARK
1153         MOVEI   C,MAINPR-1
1154         MOVEI   B,TPVP
1155         MOVE    A,MAINPR        ; MARK MAIN PROCES EVEN IF SWAPPED OUT
1156         PUSHJ   P,MARK
1157         MOVEM   A,MAINPR                ; ADJUST PTR
1158
1159 ; ASSOCIATION AND VALUE FLUSHING PHASE
1160
1161         SKIPN   GCHAIR          ; ONLY IF HAIR
1162         PUSHJ   P,VALFLS
1163
1164         SKIPN   GCHAIR
1165         PUSHJ   P,ATCLEA        ; CLEAN UP ATOM TABLE
1166
1167         SKIPE   GCHAIR          ; IF NOT HAIR, DO CHANNELS NOW
1168         PUSHJ   P,CHNFLS
1169
1170         PUSHJ   P,ASSOUP        ; UPDATE AND MOVE ASSOCIATIONS
1171         PUSHJ   P,CHFIX         ; SEND OUT CHANNELS AND MARK LOSERS
1172         PUSHJ   P,STOGC         ; FIX UP FROZEN WORLD
1173         MOVE    P,GCPDL         ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS
1174
1175
1176         MOVE    A,NPARBO                ; UPDATE GCSBOT
1177         MOVEM   A,GCSBOT
1178         MOVE    A,PURSVT
1179         PUSH    P,PURVEC+1
1180         MOVEM   A,PURVEC+1      ; RESTORE PURVEC
1181         PUSHJ   P,CORADJ        ; ADJUST CORE SIZE
1182         POP     P,PURVEC+1
1183
1184
1185
1186 \f; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE
1187
1188 NOMAP1: MOVEI   A,@BOTNEW
1189         ADDI    A,1777          ; TO PAGE BOUNDRY
1190         ANDCMI  A,1777
1191         MOVE    B,A
1192 DOMAP:  ASH     B,-10.          ; TO PAGES
1193         MOVE    A,PARBOT
1194         MOVEI   C,(A)           ; COMPUTE HIS TOP
1195         ASH     C,-10.
1196         ASH     A,-10.
1197         SUBM    A,B             ; B==> - # OF PAGES
1198         HRLI    A,(B)           ; AOBJN TO SOURCE AND DEST
1199         MOVE    B,A             ; IN CASE OF FUNNY
1200         HRRI    B,(C)           ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES
1201         PUSHJ   P,%INFMP        ; NOW FLUSH INF AND MAKE HIS CORE MINE
1202         JRST    GARZER
1203
1204 \f; CORE ADJUSTMENT PHASE
1205
1206 CORADJ: MOVE    A,PURTOP
1207         SUB     A,CURPLN        ; ADJUST FOR RSUBR
1208         ANDCMI  A,1777          ; ROUND DOWN
1209         MOVEM   A,RPTOP
1210         MOVEI   A,@BOTNEW       ; NEW GCSTOP
1211         ADDI    A,1777          ; GCPDL AND ROUND
1212         ANDCMI  A,1777          ; TO PAGE BOUNDRY
1213         MOVEM   A,CORTOP        ; TAKE CARE OF POSSIBLE LATER LOSSAGE
1214         CAMLE   A,RPTOP         ; SEE IF WE CAN MAP THE WORLD BACK IN
1215         FATAL   AGC--UNABLE TO MAP GC-SPACE INTO CORE
1216         CAMG    A,PURBOT        ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT
1217         JRST    CORAD0          ; DON'T HAVE TO PUNT SOME PURE
1218         PUSHJ   P,MAPOUT        ; GET THE CORE
1219         FATAL   AGC--PAGES NOT AVAILABLE
1220
1221 ; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS
1222 ; FIRST LETS SEE IF WE HAVE TO CORE DOWN.
1223 ; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED
1224
1225 CORAD0: SKIPN   B,GCDOWN        ; CORE DOWN?
1226         JRST    CORAD1          ; NO, LETS GET CORE REQUIREMENTS
1227         ADDI    A,(B)           ; AMOUNT+ONE FREE BLOCK
1228         CAMGE   A,RPTOP         ; CAN WE WIN
1229         JRST    CORAD3          ; POSSIBLY
1230
1231 ; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR
1232 CORAD2: SETOM   GCDANG          ; INDICATE LOSSAGE
1233
1234 ; CALCULATE PARAMETERS BEFORE LEAVING
1235 CORAD6: MOVE    A,PURSVT        ; GET PURE TABLE
1236         PUSHJ   P,SPCOUT        ; OUT IT GOES IN CASE IT WAS CHANGED
1237         MOVEI   A,@BOTNEW       ; GCSTOP
1238         MOVEM   A,GCSTOP
1239         MOVE    A,CORTOP        ; ADJUST CORE IMAGE
1240         ASH     A,-10.          ; TO PAGES
1241 TRYPCO: PUSHJ   P,P.CORE
1242         FATAL AGC--CORE SCREW UP
1243         MOVE    A,CORTOP        ; GET IT BACK
1244         ANDCMI  A,1777
1245         MOVEM   A,FRETOP
1246         MOVEM   A,RFRETP
1247         POPJ    P,
1248
1249 ; TRIES TO SATISFY REQUEST FOR CORE
1250 CORAD1: MOVEM   A,CORTOP
1251         MOVEI   A,@BOTNEW
1252         ADD     A,GETNUM        ; ADD MINIMUM CORE NEEDED
1253         ADDI    A,1777          ; ONE BLOCK+ROUND
1254         ANDCMI  A,1777          ; TO BLOCK BOUNDRY
1255         CAMLE   A,RPTOP         ; CAN WE WIN
1256         JRST    CORAD2          ; LOSE
1257         CAMGE   A,PURBOT
1258         JRST    CORAD7          ; DON'T HAVE TO MAP OUT PURE
1259         PUSHJ   P,MAPOUT
1260         JRST    CORAD2          ; LOSS
1261
1262 ; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE
1263 CORAD7: MOVEM   A,CORTOP        ; STORE POSSIBLE VALUE
1264         MOVE    B,RPTOP         ; GET REAL PURTOP
1265         SUB     B,PURMIN        ; KEEP PURMIN
1266         CAMG    B,CORTOP        ; SEE IF CORTOP IS ALREADY HIGH
1267         MOVE    B,CORTOP                ; DONT GIVE BACK WHAT WE GOT
1268         MOVEM   B,RPTOP         ; FOOL CORE HACKING
1269         ADD     A,FREMIN
1270         ANDCMI  A,1777          ; TO PAGE BOUNDRY
1271         CAMGE   A,RPTOP         ; DO WE WIN TOTALLY
1272         JRST    CORAD4
1273         MOVE    A,RPTOP         ; GET AS MUCH CORE AS POSSIBLE
1274         PUSHJ   P,MAPOUT
1275         JRST    CORAD6          ; LOSE, BUT YOU CAN'T HAVE EVERYTHING
1276 CORAD4: CAMG    A,PURBOT        ; DO WE HAVE TO PUNT SOME PURE
1277         JRST    CORAD8
1278         PUSHJ   P,MAPOUT        ; GET IT
1279         JRST    CORAD6
1280 CORAD8: MOVEM   A,CORTOP        ; ADJUST PARAMETER
1281         JRST    CORAD6          ; WIN TOTALLY
1282
1283 ; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE
1284
1285 CORAD3: ADD     A,FREMIN
1286         ANDCMI  A,1777
1287         CAMGE   A,PURBOT        ; CAN WE WIN
1288         JRST    CORAD9
1289         MOVE    A,RPTOP
1290 CORAD9: SUB     A,GCDOWN        ; SATISFY GCDOWN REQUEST
1291         JRST    CORAD4          ; GO CHECK ALLOCATION
1292
1293 MAPOUT: PUSH    P,A             ; SAVE A
1294         SUB     A,P.TOP         ; AMOUNT TO GET
1295         ADDI    A,1777          ; ROUND
1296         ANDCMI  A,1777          ; TO PAGE BOUNDRY
1297         ASH     A,-PGSZ         ; TO PAGES
1298         PUSHJ   P,GETPAG        ; GET THEN
1299         JRST    MAPLOS          ; LOSSAGE
1300         AOS     -1(P)           ; INDICATE WINNAGE
1301 MAPLOS: POP     P,A
1302         POPJ    P,
1303
1304
1305 \f;GARBAGE ZEROING PHASE
1306 GARZER: MOVE    A,GCSTOP        ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE
1307         MOVE    B,FRETOP        ;LAST ADDRESS OF GARBAGE + 1
1308         CAIL    A,(B)
1309          JRST   GARZR1
1310         CLEARM  (A)             ;ZERO   THE FIRST WORD
1311         CAIL    A,-1(B)         ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP)
1312          JRST   GARZR1          ; DON'T BLT
1313 IFE ITS,[
1314         MOVEI   B,777(A)
1315         ANDCMI  B,777
1316 ]
1317         HRLS    A
1318         ADDI    A,1             ;MAKE A A BLT POINTER
1319         BLT     A,-1(B)         ;AND COPY ZEROES INTO REST OF AREA
1320 IFE ITS,[
1321
1322 ; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE)
1323
1324         MOVE    D,PURBOT
1325         ASH     D,-PGSZ
1326         ASH     B,-PGSZ
1327         MOVNI   A,1
1328         MOVEI   C,0
1329         HRLI    B,400000
1330
1331 GARZR2: CAIG    D,(B)
1332          JRST   GARZR1
1333
1334         PMAP
1335         AOJA    B,GARZR2
1336 ]
1337
1338
1339 ; NOW REHASH THE ASSOCIATIONS BASED ON VALUES
1340 GARZR1: PUSHJ   P,REHASH
1341
1342
1343 \f;RESTORE AC'S
1344 TRYCOX: SKIPN   GCMONF
1345         JRST    NOMONO
1346         MOVEI   B,[ASCIZ /GOUT /]
1347         PUSHJ   P,MSGTYP
1348 NOMONO: MOVE    PVP,PVSTOR+1
1349         IRP     AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
1350         MOVE    AC,AC!STO+1(PVP)
1351         TERMIN
1352         SKIPN   DSTORE
1353         SETZM   DSTO(PVP)
1354         MOVE    PVP,PVPSTO+1(PVP)
1355
1356 ; CLOSING ROUTINE FOR G-C
1357         PUSH    P,A             ; SAVE AC'C
1358         PUSH    P,B
1359         PUSH    P,C
1360         PUSH    P,D
1361
1362         MOVE    A,FRETOP        ; ADJUST BLOAT-STAT PARAMETERS
1363         SUB     A,GCSTOP
1364         ADDM    A,NOWFRE
1365         PUSHJ   P,GCSET         ; FIX UP BLOAT-STAT PARAMETERS
1366         MOVE    A,CURTP
1367         ADDM    A,NOWTP
1368         MOVE    A,CURP
1369         ADDM    A,NOWP
1370
1371         PUSHJ   P,CTIME
1372         FSBR    B,GCTIM         ; GET TIME ELAPSED
1373         MOVEM   B,GCTIM         ; SAVE ELAPSED TIME FOR INT-HANDLER
1374         SKIPN   GCMONF          ; SEE IF MONITORING
1375         JRST    GCCONT
1376         PUSHJ   P,FIXSEN        ; OUTPUT TIME
1377         MOVEI   A,15            ; OUTPUT C/R LINE-FEED
1378         PUSHJ   P,IMTYO
1379         MOVEI   A,12
1380         PUSHJ   P,IMTYO
1381 GCCONT: MOVE    C,[NTPGOO,,NTPMAX]      ; MAY FIX UP TP PARAMS TO ENCOURAGE
1382                                         ; SHRINKAGE FOR EXTRA ROOM
1383         SKIPE   GCDANG
1384         MOVE    C,[ETPGOO,,ETPMAX]
1385         HLRZM   C,TPGOOD
1386         HRRZM   C,TPMAX
1387         POP     P,D             ; RESTORE AC'C
1388         POP     P,C
1389         POP     P,B
1390         POP     P,A
1391         MOVE    A,GCDANG
1392         JUMPE   A,AGCWIN                ; IF ZERO THE GC WORKED
1393         SKIPN   GCHAIR          ; SEE IF HAIRY GC
1394         JRST    BTEST
1395 REAGCX: MOVEI   A,1             ; PREPARE FOR A HAIRY GC
1396         MOVEM   A,GCHAIR
1397         SETZM   GCDANG
1398         MOVE    C,[11,,10.]     ; REASON FOR GC
1399         JRST    IAGC
1400
1401 BTEST:  SKIPE   INBLOT
1402         JRST    AGCWIN
1403         FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS
1404         JRST    REAGCX
1405
1406 AGCWIN: SETZM   PARNEW          ;CLEAR FOR NEXT AGC CALL
1407         SETZM   GETNUM          ;ALSO CLEAR THIS
1408         SETZM   INBLOT
1409         SETZM   GCFLG
1410
1411         SETZM   PGROW           ; CLEAR GROWTH
1412         SETZM   TPGROW
1413         SETOM   GCHAPN          ; INDICATE A GC HAS HAPPENED
1414         SETOM   GCHPN
1415         SETOM   INTFLG          ; AND REQUEST AN INTERRUPT
1416         SETZM   GCDOWN
1417         PUSHJ   P,RBLDM
1418         JUMPE   R,FINAGC
1419         JUMPN   M,FINAGC                ; IF M 0, RUNNING RSUBR SWAPPED OUT
1420         SKIPE   PLODR           ; LOADING ONE, M = 0 IS OK
1421          JRST   FINAGC
1422
1423         FATAL AGC--RUNNING RSUBR WENT AWAY
1424
1425 AGCE1:  FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR
1426
1427 \f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
1428 ; POINT.
1429
1430 FIXSEN: PUSH    P,B             ; SAVE TIME
1431         MOVEI   B,[ASCIZ /TIME= /]
1432         PUSHJ   P,MSGTYP        ; PRINT OUT MESSAGE
1433         POP     P,B             ; RESTORE B
1434         FMPRI   B,(100.0)       ; CONVERT TO FIX
1435         MULI    B,400
1436         TSC     B,B
1437         ASH     C,-163.(B)
1438         MOVEI   A,1             ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
1439         PUSH    P,C
1440         IDIVI   C,10.           ; START COUNTING
1441         JUMPLE  C,.+2
1442         AOJA    A,.-2
1443         POP     P,C
1444         CAIN    A,1             ; SEE IF THERE IS ONLY ONE CHARACTER
1445         JRST    DOT1
1446 FIXOUT: IDIVI   C,10.           ; RECOVER NUMBER
1447         HRLM    D,(P)
1448         SKIPE   C
1449         PUSHJ   P,FIXOUT
1450         PUSH    P,A             ; SAVE A
1451         CAIN    A,2             ; DECIMAL POINT HERE?
1452         JRST    DOT2
1453 FIX1:   HLRZ    A,(P)-1         ; GET NUMBER
1454         ADDI    A,60            ; MAKE IT A CHARACTER
1455         PUSHJ   P,IMTYO         ; OUT IT GOES
1456         POP     P,A
1457         SOJ     A,
1458         POPJ    P,
1459 DOT1:   MOVEI   A,".            ; OUTPUT DECIMAL POINT AND PADDING 0
1460         PUSHJ   P,IMTYO
1461         MOVEI   A,"0
1462         PUSHJ   P,IMTYO
1463         JRST    FIXOUT          ; CONTINUE
1464 DOT2:   MOVEI   A,".            ; OUTPUT DECIMAL POINT
1465         PUSHJ   P,IMTYO
1466         JRST    FIX1
1467
1468
1469 \f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
1470
1471 PDLCHK: JUMPGE  A,CPOPJ
1472         HLRE    B,A             ;GET NEGATIVE COUNT
1473         MOVE    C,A             ;SAVE A COPY OF PDL POINTER
1474         SUBI    A,-1(B)         ;LOCATE DOPE WORD PAIR
1475         HRRZS   A               ; ISOLATE POINTER
1476         CAME    A,TPGROW        ;GROWING?
1477         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
1478         MOVMS   B
1479         CAIN    A,2(C)
1480         JRST    NOFENC
1481         SETOM   1(C)            ; START FENECE POST
1482         CAIN    A,3(C)
1483         JRST    NOFENC
1484         MOVSI   D,1(C)          ;YES, SET UP TO BLT FENCE POSTS
1485         HRRI    D,2(C)
1486         BLT     D,-2(A)         ;FENCE POST ALL EXCEPT DOPE WORDS
1487
1488
1489 NOFENC: CAMG    B,TPMAX         ;NOW CHECK SIZE
1490         CAMG    B,TPMIN
1491         JRST    MUNGTP          ;TOO BIG OR TOO SMALL
1492         POPJ    P,
1493
1494 MUNGTP: SUB     B,TPGOOD        ;FIND DELTA TP
1495 MUNG3:  MOVE    C,-1(A)         ;IS GROWTH ALREADY SPECIFIED
1496         TRNE    C,777000        ;SKIP IF NOT
1497         POPJ    P,              ;ASSUME GROWTH GIVEN WILL WIN
1498
1499         ASH     B,-6            ;CONVERT TO NUMBER OF BLOCKS
1500         JUMPLE  B,MUNGT1
1501         CAILE   B,377           ; SKIP IF BELOW MAX
1502         MOVEI   B,377           ; ELSE USE MAX
1503         TRO     B,400           ;TURN ON SHRINK BIT
1504         JRST    MUNGT2
1505 MUNGT1: MOVMS   B
1506         ANDI    B,377
1507 MUNGT2: DPB     B,[111100,,-1(A)]       ;STORE IN DOPE WORD
1508         POPJ    P,
1509
1510 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
1511
1512 PDLCHP: HLRE    B,A             ;-LENGTH TO B
1513         MOVE    C,A
1514         SUBI    A,-1(B)         ;POINT TO DOPE WORD
1515         HRRZS   A               ;ISOLATE POINTER
1516         CAME    A,PGROW         ;GROWING?
1517         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
1518         MOVMS   B
1519         CAIN    A,2(C)
1520         JRST    NOPF
1521         SETOM   1(C)            ; START FENECE POST
1522         CAIN    A,3(C)
1523         JRST    NOPF
1524         MOVSI   D,1(C)
1525         HRRI    D,2(C)
1526         BLT     D,-2(A)
1527
1528 NOPF:   CAMG    B,PMAX          ;TOO BIG?
1529         CAMG    B,PMIN          ;OR TOO LITTLE
1530         JRST    .+2             ;YES, MUNG IT
1531         POPJ    P,
1532         SUB     B,PGOOD
1533         JRST    MUNG3
1534
1535
1536 ; ROUTINE TO PRE MARK SPECIAL HACKS
1537
1538 PRMRK:  SKIPE   GCHAIR          ; FLUSH IF NO HAIR
1539         POPJ    P,
1540 PRMRK2: HLRE    B,A
1541         SUBI    A,(B)           ;POINT TO DOPE WORD
1542         HLRZ    F,1(A)          ; GET LNTH
1543         LDB     0,[111100,,(A)] ; GET GROWTHS
1544         TRZE    0,400           ; SIGN HACK
1545         MOVNS   0
1546         ASH     0,6             ; TO WORDS
1547         ADD     F,0
1548         LDB     0,[001100,,(A)]
1549         TRZE    0,400
1550         MOVNS   0
1551         ASH     0,6
1552         ADD     F,0
1553         PUSHJ   P,ALLOGC
1554         HRRM    0,1(A)          ; NEW RELOCATION FIELD
1555         IORM    D,1(A)          ;AND MARK
1556         POPJ    P,
1557
1558
1559 \f;GENERAL MARK SUBROUTINE.  CALLED TO MARK ALL THINGS
1560 ; A/ GOODIE TO MARK FROM
1561 ; B/ TYPE OF A (IN RH)
1562 ; C/ TYPE,DATUM PAIR POINTER
1563
1564 MARK2A:
1565 MARK2:  HLRZ    B,(C)           ;GET TYPE
1566 MARK1:  MOVE    A,1(C)          ;GET GOODIE
1567 MARK:   SKIPN   DUMFLG
1568         JUMPE   A,CPOPJ         ; NEVER MARK 0
1569         MOVEI   0,1(A)
1570         CAIL    0,@PURBOT
1571         JRST    GCRETD
1572 MARCON: PUSH    P,A
1573         HRLM    C,-1(P)         ;AND POINTER TO IT
1574         ANDI    B,TYPMSK        ; FLUSH MONITORS
1575         SKIPE   DUMFLG          ; SKIP IF NOT IN DUMPER
1576         PUSHJ   P,TYPHK         ; HACK SOME TYPES
1577         LSH     B,1             ;TIMES 2 TO GET SAT
1578         HRRZ    B,@TYPNT        ;GET SAT
1579         ANDI    B,SATMSK
1580         JUMPE   A,GCRET
1581         CAILE   B,NUMSAT        ; SKIP IF TEMPLATE DATA
1582         JRST    TD.MRK
1583         SKIPN   GCDFLG
1584 IFN ITS,[
1585         JRST    @MKTBS(B)       ;AND GO MARK
1586         JRST    @GCDISP(B)      ; DISPATCH FOR DUMPERS
1587 ]
1588 IFE ITS,[
1589         SKIPA   E,MKTBS(B)
1590         MOVE    E,GCDISP(B)
1591         HRLI    E,-1
1592         JRST    (E)
1593 ]
1594 ; HERE TO MARK A POSSIBLE DEFER POINTER
1595
1596 DEFQMK: GETYP   B,(A)           ; GET ITS TYPE
1597         LSH     B,1
1598         HRRZ    B,@TYPNT
1599         ANDI    B,SATMSK        ; AND TO SAT
1600         SKIPGE  MKTBS(B)
1601
1602 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
1603
1604 DEFMK:  TLOA    TYPNT,400000    ;USE SIGN BIT AS FLAG
1605
1606 ;HERE TO MARK LIST ELEMENTS
1607
1608 PAIRMK: TLZ     TYPNT,400000    ;TURN OF DEFER BIT
1609         PUSH    P,[0]           ; WILL HOLD BACK PNTR
1610         MOVEI   C,(A)           ; POINT TO LIST
1611 PAIRM1: CAMGE   C,PARTOP        ;CHECK FOR BEING IN BOUNDS
1612         CAMGE   C,PARBOT
1613         FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE
1614         SKIPGE  B,(C)           ;SKIP IF NOT MARKED
1615         JRST    RETNEW          ;ALREADY MARKED, RETURN
1616         IORM    D,(C)           ;MARK IT
1617         SKIPL   FPTR            ; SEE IF IN FRONTEIR
1618         PUSHJ   P,MOVFNT        ; EXPAND THE FRONTEIR
1619         MOVEM   B,FRONT(FPTR)
1620         MOVE    0,1(C)          ; AND 2D
1621         AOBJN   FPTR,.+2        ; AOS AND CHECK FRONTEIR
1622         PUSHJ   P,MOVFNT        ; EXPAND FRONTEIR
1623         MOVEM   0,FRONT(FPTR)
1624         ADD     FPTR,[1,,1]     ; MOVE ALONG IN FRONTIER
1625
1626
1627 PAIRM2: MOVEI   A,@BOTNEW       ; GET INF ADDR
1628         SUBI    A,2
1629         HRRM    A,(C)           ; LEAVE A POINTER TO NEW HOME
1630         HRRZ    E,(P)           ; GET BACK POINTER
1631         JUMPE   E,PAIRM7        ; 1ST ONE, NEW FIXUP
1632         MOVSI   0,(HRRM)        ; INS FOR CLOBBER
1633         PUSHJ   P,SMINF         ; SMASH INF'S CORE IMAGE
1634 PAIRM4: MOVEM   A,(P)           ; NEW BACK POINTER
1635         JUMPL   TYPNT,DEFDO     ;GO HANDLE DEFERRED POINTER
1636         HRLM    B,(P)           ; SAVE OLD CDR
1637         PUSHJ   P,MARK2         ;MARK THIS DATUM
1638         HRRZ    E,(P)           ; SMASH CAR IN CASE CHANGED
1639         ADDI    E,1
1640         MOVSI   0,(MOVEM)
1641         PUSHJ   P,SMINF
1642         HLRZ    C,(P)           ;GET CDR OF LIST
1643         CAIGE   C,@PURBOT       ; SKIP IF PURE (I.E. DONT MARK)
1644         JUMPN   C,PAIRM1        ;IF NOT NIL, MARK IT
1645 GCRETP: SUB     P,[1,,1]
1646
1647 GCRET:  TLZ     TYPNT,400000    ;FOR PAIRMKS BENEFIT
1648         HLRZ    C,-1(P)         ;RESTORE C
1649         POP     P,A
1650         POPJ    P,              ;AND RETURN TO CALLER
1651
1652 GCRETD: ANDI    B,TYPMSK        ; TURN OFF MONITORS
1653         CAIN    B,TLOCR         ; SEE IF A LOCR
1654         JRST    MARCON
1655         SKIPN   GCDFLG          ; SKIP IF IN PURIFIER OR DUMPER
1656         POPJ    P,
1657         CAIE    B,TATOM         ; WE MARK PURE ATOMS
1658          CAIN   B,TCHSTR        ; AND STRINGS
1659           JRST  MARCON
1660         POPJ    P,
1661
1662 ;HERE TO MARK DEFERRED POINTER
1663
1664 DEFDO:  PUSH    P,B             ; PUSH OLD PAIR ON STACK
1665         PUSH    P,1(C)
1666         MOVEI   C,-1(P)         ; USE AS NEW DATUM
1667         PUSHJ   P,MARK2         ;MARK THE DATUM
1668         HRRZ    E,-2(P)         ; GET POINTER IN INF CORE
1669         ADDI    E,1
1670         MOVSI   0,(MOVEM)
1671         PUSHJ   P,SMINF         ; AND CLOBBER
1672         HRRZ    E,-2(P)
1673         MOVE    A,-1(P)
1674         MOVSI   0,(HRRM)                ; SMASH IN RIGHT HALF
1675         PUSHJ   P,SMINF
1676         SUB     P,[3,,3]
1677         JRST    GCRET           ;AND RETURN
1678
1679
1680 PAIRM7: MOVEM   A,-1(P)         ; SAVE NEW VAL FOR RETURN
1681         JRST    PAIRM4
1682
1683 RETNEW: HRRZ    A,(C)           ; POINT TO NEW WORLD LOCN
1684         HRRZ    E,(P)           ; BACK POINTER
1685         JUMPE   E,RETNW1        ; NONE
1686         MOVSI   0,(HRRM)
1687         PUSHJ   P,SMINF
1688         JRST    GCRETP
1689
1690 RETNW1: MOVEM   A,-1(P)
1691         JRST    GCRETP
1692
1693 ; ROUTINE TO EXPAND THE FRONTEIR
1694
1695 MOVFNT: PUSH    P,B             ; SAVE REG B
1696         HRRZ    A,BOTNEW        ; CURRENT BOTTOM OF WINDOW
1697         ADDI    A,2000          ; MOVE IT UP
1698         HRRM    A,BOTNEW
1699         HRRZM   A,FNTBOT                ; BOTTOM OF FRONTEIR
1700         MOVEI   B,FRNP
1701         ASH     A,-10.          ; TO PAGES
1702         PUSHJ   P,%GETIP
1703         PUSHJ   P,%SHWND        ; SHARE THE PAGE
1704         MOVSI   FPTR,-2000      ; FIX UP FPTR
1705         POP     P,B
1706         POPJ    P,
1707
1708
1709 ; ROUTINE TO SMASH INFERIORS PPAGES
1710 ; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE
1711
1712 SMINF:  CAMGE   E,FNTBOT
1713         JRST    SMINF1          ; NOT IN FRONTEIR
1714         SUB     E,FNTBOT        ; ADJUST POINTER
1715         IOR     0,[0 A,FRONT(E)]        ; BUILD INSTRUCTION
1716         XCT     0               ; XCT IT
1717         POPJ    P,              ; EXIT
1718 SMINF1: CAML    E,WNDBOT
1719         CAML    E,WNDTOP        ; SEE IF IN WINDOW
1720         JRST    SMINF2
1721 SMINF3: SUB     E,WNDBOT        ; FIX UP
1722         IOR     0,[0 A,WIND(E)] ; FIX INS
1723         XCT     0
1724         POPJ    P,
1725 SMINF2: PUSH    P,A             ; SAVE E
1726         PUSH    P,B             ; SAVE B
1727         HRRZ    A,E             ; E SOMETIMES HAS STUFF IN LH
1728         ASH     A,-10.
1729         MOVEI   B,WNDP          ; WINDOW PAGE
1730         PUSHJ   P,%SHWND        ; SHARE IT
1731         ASH     A,10.           ; TO PAGES
1732         MOVEM   A,WNDBOT                ; UPDATE POINTERS
1733         ADDI    A,2000
1734         MOVEM   A,WNDTOP
1735         POP     P,B             ; RESTORE ACS
1736         POP     P,A
1737         JRST    SMINF3          ; FIX UP INF
1738
1739
1740
1741 \f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
1742
1743 TPMK:   TLOA    TYPNT,400000    ;SET TP MARK FLAG
1744 VECTMK: TLZ     TYPNT,400000
1745         MOVEI   0,@BOTNEW       ; POINTER TO INF
1746         PUSH    P,0
1747         MOVEI   E,(A)           ;SAVE A POINTER TO THE VECTOR
1748         HLRE    B,A             ;GET -LNTH
1749         SUB     A,B             ;LOCATE DOPE WORD
1750         MOVEI   A,1(A)          ;ZERO LH AND POINT TO 2ND DOPE WORD
1751         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1752         CAMLE   A,GCSTOP
1753         JRST    VECTB1          ;LOSE, COMPLAIN
1754
1755         HLLM    TYPNT,(P)       ; SAVE MARKER INDICATING STACK
1756         JUMPGE  TYPNT,NOBUFR    ;IF A VECTOR, NO BUFFER CHECK
1757         CAME    A,PGROW         ;IS THIS THE BLOWN P
1758         CAMN    A,TPGROW        ;IS THIS THE GROWING PDL
1759         JRST    NOBUFR          ;YES, DONT ADD BUFFER
1760         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
1761         MOVSI   0,-PDLBUF       ;ALSO FIX UP POINTER
1762         ADD     0,1(C)
1763         MOVEM   0,-1(P)         ; FIXUP RET'D PNTR
1764
1765 NOBUFR: HLRE    B,(A)           ;GET LENGTH FROM DOPE WORD
1766         JUMPL   B,EXVECT        ; MARKED, LEAVE
1767         LDB     B,[111100,,-1(A)]       ; GET TOP GROWTH
1768         TRZE    B,400           ; HACK SIGN BIT
1769         MOVNS   B
1770         ASH     B,6             ; CONVERT TO WORDS
1771         PUSH    P,B             ; SAVE TOP GROWTH
1772         LDB     0,[001100,,-1(A)]       ;GET GROWTH FACTOR
1773         TRZE    0,400           ;KILL SIGN BIT AND SKIP IF +
1774         MOVNS   0               ;NEGATE
1775         ASH     0,6             ;CONVERT TO NUMBER OF WORDS
1776         PUSH    P,0             ; SAVE BOTTOM GROWTH
1777         ADD     B,0             ;TOTAL GROWTH TO B
1778 VECOK:  HLRE    E,(A)           ;GET LENGTH AND MARKING
1779         MOVEI   F,(E)           ;SAVE A COPY
1780         ADD     F,B             ;ADD GROWTH
1781         SUBI    E,2             ;- DOPE WORD LENGTH
1782         IORM    D,(A)           ;MAKE SURE NOW MARKED
1783         PUSHJ   P,ALLOGC        ; ALLOCATE SPACE FOR VECTOR IN THE INF
1784         HRRM    0,(A)
1785 VECOK1: JUMPLE  E,MOVEC2        ; ZERO LENGTH, LEAVE
1786         PUSH    P,A             ; SAVE POINTER TO DOPE WORD
1787         SKIPGE  B,-1(A)         ;SKIP IF UNIFORM
1788         TLNE    B,377777-.VECT. ;SKIP IF NOT SPECIAL
1789         JUMPGE  TYPNT,NOTGEN    ;JUMP IF NOT A GENERAL VECTOR
1790
1791 GENRAL: HLRZ    0,B             ;CHECK FOR PSTACK
1792         TRZ     0,.VECT.
1793         JUMPE   0,NOTGEN        ;IT ISN'T GENERAL
1794         JUMPL   TYPNT,TPMK1     ; JUMP IF TP
1795         MOVEI   C,(A)
1796         SUBI    C,1(E)          ; C POINTS TO BEGINNING OF VECTOR
1797
1798 \f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR
1799 VECTM2: HLRE    B,(C)           ;GET TYPE AND MARKING
1800         JUMPL   B,UMOVEC                ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1801         MOVE    A,1(C)          ;DATUM TO A
1802
1803
1804 VECTM3: PUSHJ   P,MARK          ;MARK DATUM
1805         MOVEM   A,1(C)          ; IN CASE WAS FIXED
1806 VECTM4: ADDI    C,2
1807         JRST    VECTM2
1808
1809 UMOVEC: POP     P,A
1810 MOVEC2: POP     P,C             ; RESTORE BOTTOM GROWTH
1811         HRRZ    E,-1(P)         ; GET POINTER INTO INF
1812         SKIPN   C               ; SKIP IF NO BOTTOM GROWTH
1813         JRST    MOVEC3
1814         JUMPL   C,.+3           ; SEE IF BOTTOM SHRINKAGE
1815         ADD     E,C             ; GROW IT
1816         JRST    MOVEC3          ; CONTINUE
1817         HRLM    C,E             ; MOVE SHRINKAGE FOR TRANSFER PHASE
1818 MOVEC3: PUSHJ   P,DOPMOD        ; MODIFY DOPE WORD AND PLACE IN INF
1819         PUSHJ   P,TRBLKV                ; SEND VECTOR INTO INF
1820 TGROT:  CAMGE   A,PARBOT                ; SKIP IF NOT STORAGE
1821         JRST    TGROT1
1822         MOVE    C,DOPSV1        ; RESTORE DOPE WORD
1823         SKIPN   (P)             ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH
1824         MOVEM   C,-1(A)
1825 TGROT1: POP     P,C             ; IS THERE TOP GROWH
1826         SKIPN   C               ; SEE IF ANY GROWTH
1827         JRST    DOPEAD
1828         SUBI    E,2
1829         SKIPG   C
1830         JRST    OUTDOP
1831         PUSH    P,C             ; SAVE C
1832         SETZ    C,              ; ZERO C
1833         PUSHJ   P,ADWD
1834         ADDI    E,1
1835         SETZ    C,              ; ZERO WHERE OLD DOPE WORDS WERE
1836         PUSHJ   P,ADWD
1837         POP     P,C
1838         ADDI    E,-1(C)         ; MAKE ADJUSTMENT FOR TOP GROWTH
1839 OUTDOP: PUSHJ   P,DOPOUT
1840 DOPEAD:
1841 EXVECT: HLRZ    B,(P)
1842         SUB     P,[1,,1]        ; GET RID OF FPTR
1843         PUSHJ   P,RELATE        ; RELATIVIZE
1844         TRNN    B,400000        ; WAS THIS A STACK
1845         JRST    GCRET
1846         MOVSI   0,PDLBUF        ; FIX UP STACK PTR
1847         ADDM    0,(P)
1848         JRST    GCRET           ; EXIT
1849
1850 VECLOS: JUMPL   C,CCRET         ;JUMP IF CAN'T MUNG TYPE
1851         HLLZ    0,(C)           ;GET TYPE
1852         MOVEI   B,TILLEG        ;GET ILLEGAL TYPE
1853         HRLM    B,(C)
1854         MOVEM   0,1(C)          ;AND STORE OLD TYPE AS VALUE
1855         JRST    UMOVEC          ;RETURN WITHOUT MARKING VECTOR
1856
1857 CCRET:  CLEARM  1(C)            ;CLOBBER THE DATUM
1858         JRST    GCRET
1859
1860 \f
1861 ; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN
1862 ; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL.
1863
1864 TPMK1:
1865 TPMK2:  POP     P,A
1866         POP     P,C
1867         HRRZ    E,-1(P)         ; FIX UP PARAMS
1868         ADDI    E,(C)
1869         PUSH    P,A             ; REPUSH A
1870         HRRZ    B,(A)           ; CALCULATE RELOCATION
1871         SUB     B,A
1872         MOVE    C,-1(P)         ; ADJUST FOR GROWTH
1873         SUB     B,C
1874         HRLZS   C
1875         PUSH    P,C
1876         PUSH    P,B
1877         PUSH    P,E
1878         PUSH    P,[0]
1879 TPMK3:  HLRZ    E,(A)           ; GET LENGTH
1880         TRZ     E,400000        ; GET RID OF MARK BIT
1881         SUBI    A,-1(E)         ;POINT TO FIRST ELEMENT
1882         MOVEI   C,(A)           ;POINT TO FIRST ELEMENT WITH C
1883 TPMK4:  HLRE    B,(C)           ;GET TYPE AND MARKING
1884         JUMPL   B,TPMK7         ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1885         HRRZ    A,(C)           ;DATUM TO A
1886         ANDI    B,TYPMSK        ; FLUSH MONITORS
1887         CAIE    B,TCBLK
1888         CAIN    B,TENTRY        ;IS THIS A STACK FRAME
1889         JRST    MFRAME          ;YES, MARK IT
1890         CAIE    B,TUBIND                ; BIND
1891         CAIN    B,TBIND         ;OR A BINDING BLOCK
1892         JRST    MBIND
1893         CAIE    B,TBVL          ; CHECK FOR OTHER BINDING HACKS
1894         CAIN    B,TUNWIN
1895         SKIPA                   ; FIX UP SP-CHAIN
1896         CAIN    B,TSKIP         ; OTHER BINDING HACK
1897         PUSHJ   P,FIXBND
1898
1899
1900 TPMK5:  PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
1901         HRRM    A,(C)           ; FIX UP IN CASE OF SP CHAIN
1902         PUSHJ   P,MARK1         ;MARK DATUM
1903         MOVE    R,A             ; SAVE A
1904         POP     P,M
1905         MOVE    A,(C)
1906         PUSHJ   P,OUTTP         ; MOVE OUT TYPE
1907         MOVE    A,R
1908         PUSHJ   P,OUTTP         ; SEND OUT VALUE
1909         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
1910 TPMK6:  ADDI    C,2
1911         JRST    TPMK4
1912
1913 MFRAME: HRRZ    0,1(C)          ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME
1914         HRROI   C,FRAMLN+FSAV-1(C)      ;POINT TO FUNCTION
1915         HRRZ    A,1(C)          ; GET IT
1916         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1917         CAMLE   A,GCSTOP
1918         JRST    MFRAM1          ; IGNORE, NOT IN VECTOR SPACE
1919         HRL     A,(A)           ; GET LENGTH
1920         MOVEI   B,TVEC
1921         PUSHJ   P,MARK          ; AND MARK IT
1922 MFRAM1: HLL     A,1(C)
1923         PUSHJ   P,OUTTP         ; SEND IT OUT
1924         HRRZ    A,OTBSAV-FSAV+1(C)      ; POINT TO TB TO PREVIOUS FRAME
1925         SKIPE   A
1926         ADD     A,-2(P)         ; RELOCATE IF NOT 0
1927         HLL     A,2(C)
1928         PUSHJ   P,OUTTP         ; SEND IT OUT
1929         MOVE    A,-2(P)         ; ADJUST AB SLOT
1930         ADD     A,ABSAV-FSAV+1(C)       ; POINT TO SAVED AB
1931         PUSHJ   P,OUTTP         ; SEND IT OUT
1932         MOVE    A,-2(P)         ; ADJUST SP SLOT
1933         ADD     A,SPSAV-FSAV+1(C)       ;POINT TO SAVED SP
1934         SUB     A,-3(P)         ; ADJUSTMENT OF LENGTH IF GROWTH
1935         PUSHJ   P,OUTTP         ; SEND IT OUT
1936         HRROI   C,PSAV-FSAV(C)  ;POINT TO SAVED P
1937         MOVEI   B,TPDL
1938         PUSHJ   P,MARK1         ;AND MARK IT
1939         PUSHJ   P,OUTTP         ; SEND IT OUT
1940         HLRE    0,TPSAV-PSAV+1(C)
1941         MOVE    A,TPSAV-PSAV+1(C)
1942         SUB     A,0
1943         MOVEI   0,1(A)
1944         MOVE    A,TPSAV-PSAV+1(C)
1945         CAME    0,TPGROW        ; SEE IF BLOWN
1946         JRST    MFRAM9
1947         MOVSI   0,PDLBUF
1948         ADD     A,0
1949 MFRAM9: ADD     A,-2(P)
1950         SUB     A,-3(P)         ; ADJUST
1951         PUSHJ   P,OUTTP
1952         MOVE    A,PCSAV-PSAV+1(C)
1953         PUSHJ   P,OUTTP
1954         HRROI   C,-PSAV+1(C)    ; POINT PAST THE FRAME
1955         JRST    TPMK4           ;AND DO MORE MARKING
1956
1957
1958 MBIND:  PUSHJ   P,FIXBND
1959         MOVEI   B,TATOM         ;FIRST MARK ATOM
1960         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL NOW
1961         SKIPE   (P)             ; PASSED MARKER, IF SO DONT SKIP
1962         JRST    MBIND2          ; GO MARK
1963         MOVE    A,1(C)          ; RESTORE A
1964         CAME    A,GCATM
1965         JRST    MBIND1          ; NOT IT, CONTINUE SKIPPING
1966         HRRM    LPVP,2(C)       ; SAVE IN RH OF TPVP,,0
1967         MOVE    0,-4(P)         ; RECOVER PTR TO DOPE WORD
1968         HRLM    0,2(C)          ; SAVE FOR MOVEMENT
1969         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
1970         PUSHJ   P,MARK1         ; MARK THE ATOM
1971         MOVEI   LPVP,(C)        ; POINT
1972         SETOM   (P)             ; INDICATE PASSAGE
1973 MBIND1: ADDI    C,6             ; SKIP BINDING
1974         MOVEI   0,6
1975         SKIPE   -1(P)           ; ONLY UPDATE IF SENDING OVER
1976         ADDM    0,-1(P)
1977         JRST    TPMK4
1978
1979 MBIND2: HLL     A,(C)
1980         PUSHJ   P,OUTTP         ; FIX UP CHAIN
1981         MOVEI   B,TATOM         ; RESTORE IN CASE SMASHED
1982         PUSHJ   P,MARK1         ; MARK ATOM
1983         PUSHJ   P,OUTTP         ; SEND IT OUT
1984         ADDI    C,2
1985         PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
1986         PUSHJ   P,MARK2         ;MARK DATUM
1987         MOVE    R,A             ; SAVE A
1988         POP     P,M
1989         MOVE    A,(C)
1990         PUSHJ   P,OUTTP         ; MOVE OUT TYPE
1991         MOVE    A,R
1992         PUSHJ   P,OUTTP         ; SEND OUT VALUE
1993         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
1994         ADDI    C,2
1995         MOVEI   B,TLIST         ; POINT TO DECL SPECS
1996         HLRZ    A,(C)
1997         PUSHJ   P,MARK          ; AND MARK IT
1998         HRR     A,(C)           ; LIST FIX UP
1999         PUSHJ   P,OUTTP
2000         SKIPL   A,1(C)          ; PREV LOC?
2001         JRST    NOTLCI
2002         MOVEI   B,TLOCI         ; NOW MARK LOCATIVE
2003         PUSHJ   P,MARK1
2004 NOTLCI: PUSHJ   P,OUTTP
2005         ADDI    C,2
2006         JRST    TPMK4
2007
2008 FIXBND: HRRZ    A,(C)           ; GET PTR TO CHAIN
2009         SKIPE   A               ; DO NOTHING IF EMPTY
2010         ADD     A,-3(P)
2011         POPJ    P,
2012 TPMK7:
2013 TPMK8:  MOVNI   A,1             ; FENCE-POST THE STACK
2014         PUSHJ   P,OUTTP
2015         ADDI    C,1             ; INCREMENT C FOR FENCE-POST
2016         SUB     P,[1,,1]        ; CLEAN UP STACK
2017         POP     P,E             ; GET UPDATED PTR TO INF
2018         SUB     P,[2,,2]        ; POP OFF RELOCATION
2019         HRRZ    A,(P)
2020         HLRZ    B,(A)
2021         TRZ     B,400000
2022         SUBI    A,-1(B)
2023         SUBI    C,(A)           ; GET # OF WORDS TRANSFERED
2024         SUB     B,C             ; GET # LEFT
2025         ADDI    E,-2(B)         ; ADJUST POINTER TO INF
2026         POP     P,A
2027         POP     P,C             ; IS THERE TOP GROWH
2028         ADD     E,C             ; MAKE ADJUSTMENT FOR TOP GROWTH
2029         ANDI    E,-1
2030         PUSHJ   P,DOPMOD        ; FIX UP DOPE WORDS
2031         PUSHJ   P,DOPOUT        ; SEND THEM OUT
2032         JRST    DOPEAD
2033
2034
2035 \f; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR
2036 ; F= # OF WORDS TO ALLOCATE
2037
2038 ALLOGC: HRRZS   A               ; GET ABS VALUE
2039         SKIPN   GCDFLG          ; SKIP IF IN DUMPER
2040         CAML    A,GCSBOT        ; SKIP IF IN STORAGE
2041         JRST    ALOGC2          ; JUMP IF ALLOCATING
2042         HRRZ    0,A
2043         POPJ    P,
2044 ALOGC2: PUSH    P,A             ; SAVE A
2045 ALOGC1: HLRE    0,FPTR          ; GET ROOM LEFT
2046         ADD     0,F             ; SEE IF ITS ENOUGH
2047         JUMPL   0,ALOCOK
2048         MOVE    F,0             ; MODIFY F
2049         PUSH    P,F
2050         PUSHJ   P,MOVFNT        ; MOVE UP FRONTEIR
2051         POP     P,F
2052         JRST    ALOGC1          ; CONTINUE
2053 ALOCOK: ADD     FPTR,F          ; MODIFY FPTR
2054         HRLZS   F
2055         ADD     FPTR,F
2056         POP     P,A             ; RESTORE A
2057         MOVEI   0,@BOTNEW
2058         SUBI    0,1             ; RELOCATION PTR
2059         POPJ    P,              ; EXIT
2060
2061
2062
2063
2064 ; TRBLK MOVES A VECTOR INTO THE INFERIOR
2065 ; E= STARTING ADDR IN INF  A= DOPE WORD OF VECTOR
2066
2067 TRBLK:  HRRZS   A
2068         SKIPE   GCDFLG
2069         JRST    TRBLK7
2070         CAMGE   A,GCSBOT        ; SEE IF IN GC-SPACE
2071         JRST    FIXDOP
2072 TRBLK7: PUSH    P,A
2073         HLRZ    0,(A)
2074         TRZ     0,400000        ; TURN OFF GC FLAG
2075         HRRZ    F,A
2076         HLRE    A,E             ; GET SHRINKAGE
2077         ADD     0,A             ; MUNG LENGTH
2078         SUB     F,0
2079         ADDI    F,1             ; F POINTS TO START OF VECTOR
2080 TRBLK2: HRRZ    R,E             ; SAVE POINTER TO INFERIOR
2081         ADD     E,0             ; E NOW POINTS TO FINAL ADDRESS+1
2082         MOVE    M,E             ;SAVE E
2083 TRBLK1: MOVE    0,R
2084         SUBI    E,1
2085         CAMGE   R,FNTBOT        ; SEE IF IN FRONTEIR
2086         JRST    TRBL10
2087         SUB     E,FNTBOT        ; ADJUST E
2088         SUB     0,FNTBOT        ; ADJ START
2089         MOVEI   A,FRONT+1777
2090         JRST    TRBLK4
2091 TRBL10: CAML    R,WNDBOT
2092         CAML    R,WNDTOP        ; SEE IF IN WINDOW
2093         JRST    TRBLK5          ; NO
2094         SUB     E,WNDBOT
2095         SUB     0,WNDBOT
2096         MOVEI   A,WIND+1777
2097 TRBLK4: ADDI    0,-1777(A)      ; CALCULATE START IN WINDOW OR FRONTEIR
2098         CAIL    E,2000
2099         JRST    TRNSWD
2100         ADDI    E,-1777(A)              ; SUBTRACT WINDBOT
2101         HRL     0,F             ; SET UP FOR BLT
2102         BLT     0,(E)
2103         POP     P,A
2104
2105 FIXDOP: IORM    D,(A)
2106         MOVE    E,M             ; GET END OF WORD
2107         POPJ    P,
2108 TRNSWD: PUSH    P,B
2109         MOVEI   B,1(A)          ; GET TOP OF WORLD
2110         SUB     B,0
2111         HRL     0,F
2112         BLT     0,(A)
2113         ADD     F,B             ; ADJUST F
2114         ADD     R,B
2115         POP     P,B
2116         MOVE    E,M             ; RESTORE E
2117         JRST    TRBLK1          ; CONTINUE
2118 TRBLK5: HRRZ    A,R             ; COPY E
2119         ASH     A,-10.          ; TO PAGES
2120         PUSH    P,B             ; SAVE B
2121         MOVEI   B,WNDP          ; IT IS WINDOW
2122         PUSHJ   P,%SHWND
2123         ASH     A,10.           ; TO PAGES
2124         MOVEM   A,WNDBOT                ; UPDATE POINTERS
2125         ADDI    A,2000
2126         MOVEM   A,WNDTOP
2127         POP     P,B             ; RESTORE B
2128         JRST    TRBL10
2129
2130
2131
2132
2133 ; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE
2134
2135 TRBLKV: HRRZS   A
2136         SKIPE   GCDFLG          ; SKIP IF NOT IN DUMPER
2137         JRST    TRBLV2
2138         CAMGE   A,GCSBOT        ; SEE IF IN GC-SPACE
2139         JRST    FIXDOP
2140 TRBLV2: PUSH    P,A             ; SAVE A
2141         HLRZ    0,DOPSV2
2142         TRZ     0,400000
2143         HRRZ    F,A
2144         HLRE    A,E             ; GET SHRINKAGE
2145         ADD     0,A             ; MUNG LENGTH
2146         SUB     F,0
2147         ADDI    F,1             ; F POINTS TO START OF VECTOR
2148         SKIPGE  -2(P)           ; SEE IF SHRINKAGE
2149         ADD     0,-2(P)         ; IF SO COMPENSATE
2150         JRST    TRBLK2          ; CONTINUE
2151
2152 ; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN   0= # OF WORDS
2153
2154 TRBLK3: PUSH    P,A             ; SAVE A
2155         MOVE    F,A
2156         JRST    TRBLK2
2157
2158 ; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT
2159 ; F==> START OF TRANSFER IN GCS 0= # OF WORDS
2160
2161 TRBLKX: PUSH    P,A             ; SAVE A
2162         JRST    TRBLK2          ; SEND IT OUT
2163
2164
2165 ; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN
2166 ; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED
2167 ; A CONTAINS THE WORD TO BE SENT OUT
2168
2169 OUTTP:  AOS     E,-2(P)         ; INCREMENT PLACE
2170         MOVSI   0,(MOVEM)               ; INS FOR SMINF
2171         SOJA    E,SMINF
2172
2173
2174 ; ADWD PLACES ONE WORD IN THE INF
2175 ; E ==> INF  C IS THE WORD
2176
2177 ADWD:   PUSH    P,E             ; SAVE AC'S
2178         PUSH    P,A
2179         MOVE    A,C             ; GET WORD
2180         MOVSI   0,(MOVEM)       ; INS FOR SMINF
2181         PUSHJ   P,SMINF         ; SMASH IT IN
2182         POP     P,A
2183         POP     P,E
2184         POPJ    P,              ; EXIT
2185
2186 ; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE
2187 ; SUCH AS THE TP AND GROWTH
2188
2189
2190 DOPOUT: MOVE    C,-1(A)
2191         PUSHJ   P,ADWD
2192         ADDI    E,1
2193         MOVE    C,(A)           ; GET SECOND DOPE WORD
2194         TLZ     C,400000        ; TURN OFF POSSIBLE MARK BIT
2195         PUSHJ   P,ADWD
2196         MOVE    C,DOPSV1        ; FIX UP FIRST DOPE WORD
2197         MOVEM   C,-1(A)
2198         MOVE    C,DOPSV2
2199         MOVEM   C,(A)           ; RESTORE SECOND D.W.
2200         POPJ    P,
2201
2202 ; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF
2203 ; A ==> DOPE WORD  E==> INF
2204
2205 DOPMOD: SKIPE   GCDFLG          ; CHECK TO SEE IF IN DUMPER AND PURIFY
2206         JRST    .+3
2207         CAMG    A,GCSBOT
2208         POPJ    P,              ; EXIT IF NOT IN GCS
2209         MOVE    C,-1(A)         ; GET FIRST DOPE WORD
2210         MOVEM   C,DOPSV1
2211         HLLZS   C               ; CLEAR OUT GROWTH
2212         TLO     C,.VECT.        ; FIX UP FOR GCHACK
2213         PUSH    P,C
2214         MOVE    C,(A)           ; GET SECOND DOPE WORD
2215         HLRZ    B,(A)           ; GET LENGTH
2216         TRZ     B,400000        ; TURN OFF MARK BIT
2217         MOVEM   C,DOPSV2
2218         HRRZ    0,-1(A)         ; CHECK FOR GROWTH
2219         JUMPE   0,DOPMD1
2220         LDB     0,[111100,,-1(A)]       ; MODIFY WITH GROWTH
2221         TRZE    0,400
2222         MOVNS   0
2223         ASH     0,6
2224         ADD     B,0
2225         LDB     0,[001100,,-1(A)]
2226         TRZE    0,400
2227         MOVNS   0
2228         ASH     0,6
2229         ADD     B,0
2230 DOPMD1: HRL     C,B             ; FIX IT UP
2231         MOVEM   C,(A)           ; FIX IT UP
2232         POP     P,-1(A)
2233         POPJ    P,
2234
2235 ADPMOD: CAMG    A,GCSBOT
2236         POPJ    P,              ; EXIT IF NOT IN GCS
2237         MOVE    C,-1(A)         ; GET FIRST DOPE WORD
2238         TLO     C,.VECT.        ; FIX UP FOR GCHACK
2239         MOVEM   C,-1(A)
2240         MOVE    C,(A)           ; GET SECOND DOPE WORD
2241         TLZ     C,400000                ; TURN OFF PARK BIT
2242         MOVEM   C,(A)
2243         POPJ    P,
2244
2245
2246
2247
2248 \f; RELATE RELATAVIZES A POINTER TO A VECTOR
2249 ; B IS THE POINTER  A==> DOPE WORD
2250
2251 RELATE: SKIPE   GCDFLG          ; SEE IF DUMPER OR PURIFIER
2252         JRST    .+3
2253         CAMGE   A,GCSBOT        ; SEE IF IN VECTOR SPACE
2254         POPJ    P,              ; IF NOT EXIT
2255         MOVE    C,-1(P)
2256         HLRE    F,C             ; GET LENGTH
2257         HRRZ    0,-1(A)         ; CHECK FO GROWTH
2258         JUMPE   A,RELAT1
2259         LDB     0,[111100,,-1(A)]       ; GET TOP GROWTH
2260         TRZE    0,400           ; HACK SIGN BIT
2261         MOVNS   0
2262         ASH     0,6             ; CONVERT TO WORDS
2263         SUB     F,0             ; ACCOUNT FOR GROWTH
2264 RELAT1: HRLM    F,C             ; PLACE CORRECTED LENGTH BACK IN POINTER
2265         HRRZ    F,(A)           ; GET RELOCATED ADDR
2266         SUBI    F,(A)           ; FIND RELATIVIZATION AMOUNT
2267         ADD     C,F             ; ADJUST POINTER
2268         SUB     C,0             ; ACCOUNT FOR GROWTH
2269         MOVEM   C,-1(P)
2270         POPJ    P,
2271
2272
2273
2274 \f; MARK TB POINTERS
2275 TBMK:   HRRZS   A               ; CHECK FOR NIL POINTER
2276         SKIPN   A
2277         JRST    GCRET           ; IF POINTING TO NIL THEN RETURN
2278         HLRE    B,TPSAV(A)      ; MAKE POINTER LOOK LIKE A TP POINTER
2279         HRRZ    C,TPSAV(A)              ; GET TO DOPE WORD
2280 TBMK2:  SUB     C,B             ; POINT TO FIRST DOPE WORD
2281         HRRZ    A,(P)           ; GET PTR TO FRAME
2282         SUB     A,C             ; GET PTR TO FRAME
2283         HRLS    A
2284         HRR     A,(P)
2285         PUSH    P,A
2286         MOVEI   C,-1(P)
2287         MOVEI   B,TTP
2288         PUSHJ   P,MARK
2289         SUB     P,[1,,1]
2290         HRRM    A,(P)
2291         JRST    GCRET
2292 ABMK:   HLRE    B,A             ; FIX UP TO GET TO FRAME
2293         SUB     A,B
2294         HLRE    B,FRAMLN+TPSAV(A)       ; FIX UP TO LOOK LIKE TP
2295         HRRZ    C,FRAMLN+TPSAV(A)
2296         JRST    TBMK2
2297
2298
2299 \f
2300 ; MARK ARG POINTERS
2301
2302 ARGMK:  HRRZ    A,1(C)          ; GET POINTER
2303         HLRE    B,1(C)          ; AND LNTH
2304         SUB     A,B             ; POINT TO BASE
2305         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
2306         CAMLE   A,GCSTOP
2307         JRST    ARGMK0
2308         HLRZ    0,(A)           ; GET TYPE
2309         ANDI    0,TYPMSK
2310         CAIN    0,TCBLK
2311         JRST    ARGMK1
2312         CAIE    0,TENTRY        ; IS NEXT A WINNER?
2313         CAIN    0,TINFO
2314         JRST    ARGMK1          ; YES, GO ON TO WIN CODE
2315
2316 ARGMK0: SETZB   A,1(C)          ; CLOBBER THE CELL
2317         SETZM   (P)             ; AND SAVED COPY
2318         JRST    GCRET
2319
2320 ARGMK1: MOVE    B,1(A)          ; ASSUME TTB
2321         ADDI    B,(A)           ; POINT TO FRAME
2322         CAIE    0,TINFO         ; IS IT?
2323         MOVEI   B,FRAMLN(A)     ; NO, USE OTHER GOODIE
2324         HLRZ    0,OTBSAV(B)     ; GET TIME
2325         HRRZ    A,(C)           ; AND FROM POINTER
2326         CAIE    0,(A)           ; SKIP IF WINNER
2327         JRST    ARGMK0
2328         MOVE    A,TPSAV(B)              ; GET A RELATAVIZED TP
2329         HRROI   C,TPSAV-1(B)
2330         MOVEI   B,TTP
2331         PUSHJ   P,MARK1
2332         SUB     A,1(C)          ; AMOUNT TO RELATAVIZE ARGS
2333         HRRZ    B,(P)
2334         ADD     B,A
2335         HRRM    B,(P)           ; PUT RELATAVIZED PTR BACK
2336         JRST    GCRET
2337
2338 \f
2339 ; MARK FRAME POINTERS
2340
2341 FRMK:   HLRZ    B,A             ; GET TIME FROM FRAME PTR
2342         HLRZ    F,OTBSAV(A)             ; GET TIME FROM FRAME
2343         CAME    B,F             ; SEE IF EQUAL
2344         JRST    GCRET
2345         SUBI    C,1             ;PREPARE TO MARK PROCESS VECTOR
2346         HRRZ    A,1(C)          ;USE AS DATUM
2347         SUBI    A,1             ;FUDGE FOR VECTMK
2348         MOVEI   B,TPVP          ;IT IS A VECTRO
2349         PUSHJ   P,MARK          ;MARK IT
2350         ADDI    A,1             ; READJUST PTR
2351         HRRM    A,1(C)          ; FIX UP PROCESS SLOT
2352         MOVEI   C,1(C)          ; SET UP FOR TBMK
2353         HRRZ    A,(P)
2354         JRST    TBMK            ; MARK LIKE TB
2355
2356 \f
2357 ; MARK BYTE POINTER
2358
2359 BYTMK:  PUSHJ   P,BYTDOP        ; GET DOPE WORD IN A
2360         HLRZ    F,-1(A)         ; GET THE TYPE
2361         ANDI    F,SATMSK        ; FLUSH MONITOR BITS
2362         CAIN    F,SATOM         ; SEE IF ATOM
2363         JRST    ATMSET
2364         HLRE    F,(A)           ; GET MARKING
2365         JUMPL   F,BYTREL        ; JUMP IF MARKED
2366         HLRZ    F,(A)           ; GET LENGTH
2367         PUSHJ   P,ALLOGC        ; ALLOCATE FOR IT
2368         HRRM    0,(A)           ; SMASH  IT IN
2369         MOVE    E,0
2370         HLRZ    F,(A)
2371         SUBI    E,-1(F)         ; ADJUST INF POINTER
2372         IORM    D,(A)
2373         PUSHJ   P,ADPMOD
2374         PUSHJ   P,TRBLK
2375 BYTREL: HRRZ    E,(A)
2376         SUBI    E,(A)
2377         ADDM    E,(P)           ; RELATAVIZE
2378         JRST    GCRET
2379
2380 ATMSET: PUSH    P,A             ; SAVE A
2381         HLRZ    B,(A)           ; GET LENGTH
2382         TRZ     B,400000        ; GET RID OF MARK BIT
2383         MOVNI   B,-2(B)         ; GET LENGTH
2384         ADDI    A,-1(B)         ; CALCULATE POINTER
2385         HRLI    A,(B)
2386         MOVEI   B,TATOM         ; TYPE
2387         PUSHJ   P,MARK
2388         POP     P,A             ; RESTORE A
2389         SKIPN   DUMFLG
2390          JRST   BYTREL
2391         HRRM    A,(P)
2392         MOVSI   E,STATM         ; GET "STRING IS ATOM BIT"
2393         IORM    E,(P)
2394         JRST    BYTREL          ; TO BYTREL
2395 \f
2396
2397 ; MARK OFFSET
2398
2399 OFFSMK: HLRZS   A
2400         PUSH    P,$TLIST
2401         PUSH    P,A             ; PUSH LIST POINTER ON THE STACK
2402         MOVEI   C,-1(P)         ; POINTER TO PAIR
2403         PUSHJ   P,MARK2         ; MARK THE LIST
2404         HRLM    A,-2(P)         ; UPDATE POINTER IN OFFSET
2405         SUB     P,[2,,2]
2406         JRST    GCRET
2407 \f
2408
2409 ; MARK ATOMS IN GVAL STACK
2410
2411 GATOMK: HRRZ    B,(C)           ; POINT TO POSSIBLE GDECL
2412         JUMPE   B,ATOMK
2413         CAIN    B,-1
2414         JRST    ATOMK
2415         MOVEI   A,(B)           ; POINT TO DECL FOR MARK
2416         MOVEI   B,TLIST
2417         MOVEI   C,0
2418         PUSHJ   P,MARK
2419         HLRZ    C,-1(P)         ; RESTORE HOME POINTER
2420         HRRM    A,(C)           ; CLOBBER UPDATED LIST IN
2421         MOVE    A,1(C)          ; RESTORE ATOM POINTER
2422
2423 ; MARK ATOMS
2424
2425 ATOMK:
2426         MOVEI   0,@BOTNEW
2427         PUSH    P,0             ; SAVE POINTER TO INF
2428         TLO     TYPNT,.ATOM.    ; SAY ATOM WAS MARKED
2429         MOVEI   C,1(A)
2430         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
2431         JRST    ATMRL1          ; ALREADY MARKED
2432         PUSH    P,A             ; SAVE DOPE WORD PTR FOR LATER
2433         HLRZ    C,(A)           ; FIND REAL ATOM PNTR
2434         SUBI    C,400001        ; KILL MARK BIT AND ADJUST
2435         HRLI    C,-1(C)
2436         SUBM    A,C             ; NOW TOP OF ATOM
2437 MRKOBL: MOVEI   B,TOBLS
2438         HRRZ    A,2(C)          ; IF > 0, NOT OBL
2439         CAMG    A,VECBOT
2440         JRST    .+3
2441         HRLI    A,-1
2442         PUSHJ   P,MARK          ; AND MARK IT
2443         HRRM    A,2(C)
2444         SKIPN   GCHAIR
2445         JRST    NOMKNX
2446         HLRZ    A,2(C)
2447         MOVEI   B,TATOM
2448         PUSHJ   P,MARK
2449         HRLM    A,2(C)
2450 NOMKNX: HLRZ    B,(C)           ; SEE IF UNBOUND
2451         TRZ     B,400000        ; TURN OFF MARK BIT
2452         SKIPE   B
2453         CAIN    B,TUNBOUND
2454         JRST    ATOMK1          ; IT IS UNBOUND
2455         HRRZ    0,(C)           ; SEE IF VECTOR OR TP POINTER
2456         MOVEI   B,TVEC          ; ASSUME VECTOR
2457         SKIPE   0
2458         MOVEI   B,TTP           ; ITS A LOCAL VALUE
2459         PUSHJ   P,MARK1         ; MARK IT
2460         MOVEM   A,1(C)          ; SMASH INTO SLOT
2461 ATOMK1: HRRZ    0,2(C)          ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT
2462         POP     P,A             ; RESTORE A
2463         POP     P,E             ; GET POINTER INTO INF
2464         SKIPN   GCHAIR
2465         JUMPN   0,ATMREL
2466         PUSHJ   P,ADPMOD
2467         PUSHJ   P,TRBLK
2468 ATMREL: HRRZ    E,(A)           ; RELATAVIZE
2469         SUBI    E,(A)
2470         ADDM    E,(P)
2471         JRST    GCRET
2472 ATMRL1: SUB     P,[1,,1]        ; POP OFF STACK
2473         JRST    ATMREL
2474
2475 \f
2476 GETLNT: HLRE    B,A             ;GET -LNTH
2477         SUB     A,B             ;POINT TO 1ST DOPE WORD
2478         MOVEI   A,1(A)          ;POINT TO 2ND DOPE WORD
2479         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
2480         CAMLE   A,GCSTOP
2481         JRST    VECTB1          ;BAD VECTOR, COMPLAIN
2482         HLRE    B,(A)           ;GET LENGTH AND MARKING
2483         IORM    D,(A)           ;MAKE SURE MARKED
2484         JUMPL   B,AMTKE
2485         MOVEI   F,(B)           ; AMOUNT TO ALLOCATE
2486         PUSHJ   P,ALLOGC        ;ALLOCATE ROOM
2487         HRRM    0,(A)           ; RELATIVIZE
2488 AMTK1:  AOS     (P)             ; A NON MARKED ITEM
2489 AMTKE:  POPJ    P,              ;AND RETURN
2490
2491 GCRET1: SUB     P,[1,,1]        ;FLUSH RETURN ADDRESS
2492         JRST    GCRET
2493
2494
2495 \f
2496 ; MARK NON-GENERAL VECTORS
2497
2498 NOTGEN: CAMN    B,[GENERAL+<SPVP,,0>]
2499         JRST    GENRAL          ;YES, MARK AS A VECTOR
2500         JUMPL   B,SPECLS        ; COMPLAIN IF A SPECIAL HACK
2501         SUBI    A,1(E)          ;POINT TO TOP OF A UNIFORM VECTOR
2502         HLRZS   B               ;ISOLATE TYPE
2503         ANDI    B,TYPMSK
2504         PUSH    P,E
2505         SKIPE   DUMFLG          ; SKIP IF NOT IN DUMPER
2506         PUSHJ   P,TYPHK         ; HACK WITH TYPE IF SPECIAL
2507         POP     P,E             ; RESTORE LENGTH
2508         MOVE    F,B             ; AND COPY IT
2509         LSH     B,1             ;FIND OUT WHERE IT WILL GO
2510         HRRZ    B,@TYPNT        ;GET SAT IN B
2511         ANDI    B,SATMSK
2512         MOVEI   C,@MKTBS(B)     ;POINT TO MARK SR
2513         CAIN    C,GCRET         ;IF NOT A MARKED FROM GOODIE, IGNORE
2514         JRST    UMOVEC
2515         MOVEI   C,-1(A)         ;POINT 1 PRIOR TO VECTOR START
2516         PUSH    P,E             ;SAVE NUMBER OF ELEMENTS
2517         PUSH    P,F             ;AND UNIFORM TYPE
2518
2519 UNLOOP: MOVE    B,(P)           ;GET TYPE
2520         MOVE    A,1(C)          ;AND GOODIE
2521         TLO     C,400000        ;CAN'T MUNG TYPE
2522         PUSHJ   P,MARK          ;MARK THIS ONE
2523         MOVEM   A,1(C)          ; LIST FIXUP
2524         SOSE    -1(P)           ;COUNT
2525         AOJA    C,UNLOOP        ;IF MORE, DO NEXT
2526
2527         SUB     P,[2,,2]        ;REMOVE STACK CRAP
2528         JRST    UMOVEC
2529
2530
2531 SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR
2532         SUB     P,[4,,4]        ; REOVER
2533         JRST    AFIXUP
2534
2535
2536 \f
2537 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
2538 ; AND UPDATES PTR TO THE TABLE.
2539
2540 GCRDMK: PUSH    P,A             ; SAVE PTR TO TOP
2541         MOVEI   0,@BOTNEW       ; SAVE PTR TO INF
2542         PUSH    P,0
2543         PUSHJ   P,GETLNT        ; GET TO D.W. AND CHECK MARKING
2544         JRST    GCRDRL          ; RELATIVIZE
2545         PUSH    P,A             ; SAVE D.W POINTER
2546         SUBI    A,2
2547         MOVE    B,ABOTN         ; GET TOP OF ATOM TABLE
2548         HRRZ    0,-2(P)
2549         ADD     B,0             ; GET BOTTOM OF ATOM TABLE
2550 GCRD1:  CAMG    A,B             ; DON'T SKIP IF DONE
2551         JRST    GCRD2
2552         HLRZ    C,(A)           ; GET MARKING
2553         TRZN    C,400000        ; SKIP IF MARKED
2554         JRST    GCRD3
2555         MOVEI   E,(A)
2556         SUBI    A,(C)           ; GO BACK ONE ATOM
2557         PUSH    P,B             ; SAVE B
2558         PUSH    P,A             ; SAVE POINTER
2559         MOVEI   C,-2(E)         ; SET UP POINTER
2560         MOVEI   B,TATOM         ; GO TO MARK
2561         MOVE    A,1(C)
2562         PUSHJ   P,MARK
2563         MOVEM   A,1(C)          ; SMASH FIXED UP ATOM BACK IN
2564         POP     P,A
2565         POP     P,B
2566         JRST    GCRD1
2567 GCRD3:  SUBI    A,(C)           ; TO NEXT ATOM
2568         JRST    GCRD1
2569 GCRD2:  POP     P,A             ; GET PTR TO D.W.
2570         POP     P,E             ; GET PTR TO INF
2571         SUB     P,[1,,1]        ; GET RID OF TOP
2572         PUSHJ   P,ADPMOD        ; FIX UP D.W.
2573         PUSHJ   P,TRBLK         ; SEND IT OUT
2574         JRST    ATMREL          ; RELATIVIZE AND LEAVE
2575 GCRDRL: POP     P,A             ; GET PTR TO D.W
2576         SUB     P,[2,,2]        ; GET RID OF TOP AND PTR TO INF
2577         JRST    ATMREL          ; RELATAVIZE
2578
2579
2580 \f
2581 ;MARK RELATAVIZED GLOC HACKS
2582
2583 LOCRMK: SKIPE   GCHAIR
2584         JRST    GCRET
2585 LOCRDP: PUSH    P,C             ; SAVE C
2586         MOVEI   C,-2(A)         ; RELATAVIZED PTR TO ATOM
2587         ADD     C,GLTOP         ; ADD GLOTOP TO GET TO ATOM
2588         MOVEI   B,TATOM         ; ITS AN ATOM
2589         SKIPL   (C)
2590         PUSHJ   P,MARK1
2591         POP     P,C             ; RESTORE C
2592         SKIPN   DUMFLG          ; IF GC-DUMP, WILL STORE ATOM FOR LOCR
2593          JRST   LOCRDD
2594         MOVEI   B,1
2595         IORM    B,3(A)          ; MUNG ATOM TO SAY IT IS LOCR
2596         CAIA
2597 LOCRDD: MOVE    A,1(C)          ; GET RELATIVIZATION
2598         MOVEM   A,(P)           ; IT STAYS THE SAVE
2599         JRST    GCRET
2600
2601 ;MARK LOCID TYPE GOODIES
2602
2603 LOCMK:  HRRZ    B,(C)           ;GET TIME
2604         JUMPE   B,LOCMK1        ; SKIP LEGAL CHECK FOR GLOBAL
2605         HRRZ    0,2(A)          ; GET OTHER TIME
2606         CAIE    0,(B)           ; SAME?
2607         SETZB   A,(P)           ; NO, SMASH LOCATIVE
2608         JUMPE   A,GCRET         ; LEAVE IF DONE
2609 LOCMK1: PUSH    P,C
2610         MOVEI   B,TATOM         ; MARK ATOM
2611         MOVEI   C,-2(A)         ; POINT TO ATOM
2612         MOVE    E,(C)           ; SEE IF BLOCK IS MARKED
2613         TLNE    E,400000                ; SKIP IF MARKED
2614         JRST    LOCMK2          ; SKIP OVER BLOCK
2615         SKIPN   GCHAIR          ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED)
2616         PUSHJ   P,MARK1         ; LET LOCATIVE SAVE THE ATOM
2617 LOCMK2: POP     P,C
2618         HRRZ    E,(C)           ; TIME BACK
2619         MOVEI   B,TVEC          ; ASSUME GLOBAL
2620         SKIPE   E
2621         MOVEI   B,TTP           ; ITS LOCAL
2622         PUSHJ   P,MARK1         ; MARK IT
2623         MOVEM   A,(P)
2624         JRST    GCRET
2625
2626 \f
2627 ; MARK ASSOCIATION BLOCKS
2628
2629 ASMRK:  PUSH    P,A
2630 ASMRK1: HRLI    A,-ASOLNT       ;LOOK LIKE A VECTOR POINTER
2631         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
2632         JRST    ASTREL          ; ALREADY MARKED
2633         MOVEI   C,-ASOLNT-1(A)          ;COPY POINTER
2634         PUSHJ   P,MARK2         ;MARK ITEM CELL
2635         MOVEM   A,1(C)
2636         ADDI    C,INDIC-ITEM    ;POINT TO INDICATOR
2637         PUSHJ   P,MARK2
2638         MOVEM   A,1(C)
2639         ADDI    C,VAL-INDIC
2640         PUSHJ   P,MARK2
2641         MOVEM   A,1(C)
2642         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL FRIENDS
2643         JRST    ASTREL
2644         HRRZ    A,NODPNT-VAL(C) ; NEXT
2645         JUMPN   A,ASMRK1                ; IF EXISTS, GO
2646 ASTREL: POP     P,A             ; RESTORE PTR TO ASSOCIATION
2647         MOVEI   A,ASOLNT+1(A)   ; POINT TO D.W.
2648         SKIPN   NODPNT-ASOLNT-1(A)      ; SEE IF EMPTY NODPTR
2649         JRST    ASTX            ; JUMP TO SEND OUT
2650 ASTR1:  HRRZ    E,(A)           ; RELATAVIZE
2651         SUBI    E,(A)
2652         ADDM    E,(P)
2653         JRST    GCRET           ; EXIT
2654 ASTX:   HRRZ    E,(A)           ; GET PTR IN FRONTEIR
2655         SUBI    E,ASOLNT+1              ; ADJUST TO POINT TO BEGINNING
2656         PUSHJ   P,ADPMOD
2657         PUSHJ   P,TRBLK
2658         JRST    ASTR1
2659
2660 ;HERE WHEN A VECTOR POINTER IS BAD
2661
2662 VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE
2663         SUB     P,[1,,1]        ; RECOVERY
2664 AFIXUP: SETZM   (P)             ; CLOBBER SLOT
2665         JRST    GCRET           ; CONTINUE
2666
2667
2668 VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE
2669         SUB     P,[2,,2]
2670         JRST    AFIXUP          ; RECOVER
2671
2672 PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE
2673         SUB     P,[1,,1]        ; RECOVER
2674         JRST    AFIXUP
2675
2676
2677 \f; HERE TO MARK TEMPLATE DATA STRUCTURES
2678
2679 TD.MRK: MOVEI   0,@BOTNEW       ; SAVE PTR TO INF
2680         PUSH    P,0
2681         HLRZ    B,(A)           ; GET REAL SPEC TYPE
2682         ANDI    B,37777         ; KILL SIGN BIT
2683         MOVEI   E,-NUMSAT-1(B)  ; GET REL POINTER TO TABLE
2684         HRLI    E,(E)
2685         ADD     E,TD.AGC+1
2686         HRRZS   C,A             ; FLUSH COUNT AND SAVE
2687         SKIPL   E               ; WITHIN BOUNDS
2688         FATAL   BAD SAT IN AGC
2689         PUSHJ   P,GETLNT        ; GOODIE IS NOW MARKED
2690         JRST    TMPREL          ; ALREADY MARKED
2691
2692         SKIPE   (E)
2693         JRST    USRAGC
2694         SUB     E,TD.AGC+1      ; POINT TO LENGTH
2695         ADD     E,TD.LNT+1
2696         XCT     (E)             ; RET # OF ELEMENTS IN B
2697
2698         HLRZ    D,B             ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
2699         PUSH    P,[0]           ; TEMP USED IF RESTS EXIST
2700         PUSH    P,D
2701         MOVEI   B,(B)           ; ZAP TO ONLY LENGTH
2702         PUSH    P,C             ; SAVE POINTER TO TEMPLATE STRUCTURE
2703         PUSH    P,[0]           ; HOME FOR VALUES
2704         PUSH    P,[0]           ; SLOT FOR TEMP
2705         PUSH    P,B             ; SAVE
2706         SUB     E,TD.LNT+1
2707         PUSH    P,E             ; SAVE FOR FINDING OTHER TABLES
2708         JUMPE   D,TD.MR2        ; NO REPEATING SEQ
2709         ADD     E,TD.GET+1      ; COMP LNTH OF REPEATING SEQ
2710         HLRE    E,(E)           ; E ==> - LNTH OF TEMPLATE
2711         ADDI    E,(D)           ; E ==> -LENGTH OF REP SEQ
2712         MOVNS   E
2713         HRLM    E,-5(P)         ; SAVE IT AND BASIC
2714
2715 TD.MR2: SKIPG   D,-1(P)         ; ANY LEFT?
2716         JRST    TD.MR1
2717
2718         MOVE    E,TD.GET+1
2719         ADD     E,(P)
2720         MOVE    E,(E)           ; POINTER TO VECTOR IN E
2721         MOVEM   D,-6(P)         ; SAVE ELMENT #
2722         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST
2723         SOJA    D,TD.MR3
2724
2725         MOVEI   0,(B)           ; BASIC LNT TO 0
2726         SUBI    0,(D)           ; SEE IF PAST BASIC
2727         JUMPGE  0,.-3           ; JUMP IF O.K.
2728         MOVSS   B               ; REP LNT TO RH, BASIC TO LH
2729         IDIVI   0,(B)           ; A==> -WHICH REPEATER
2730         MOVNS   A
2731         ADD     A,-5(P)         ; PLUS BASIC
2732         ADDI    A,1             ; AND FUDGE
2733         MOVEM   A,-6(P)         ; SAVE FOR PUTTER
2734         ADDI    E,-1(A)         ; POINT
2735         SOJA    D,.+2
2736
2737 TD.MR3: ADDI    E,(D)           ; POINT TO SLOT
2738         XCT     (E)             ; GET THIS ELEMENT INTO A AND B
2739         JFCL                    ; NO-OP FOR ANY CASE
2740         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT
2741         MOVEM   B,-2(P)
2742         EXCH    A,B             ; REARRANGE
2743         GETYP   B,B
2744         MOVEI   C,-3(P)         ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG
2745         MOVSI   D,400000        ; RESET FOR MARK
2746         PUSHJ   P,MARK          ; AND MARK THIS GUY (RET FIXED POINTER IN A)
2747         MOVE    C,-4(P)         ; REGOBBLE POINTER TO TEMPLATE
2748         MOVE    E,TD.PUT+1
2749         MOVE    B,-6(P)         ; RESTORE COUNT
2750         ADD     E,(P)
2751         MOVE    E,(E)           ; POINTER TO VECTOR IN E
2752         ADDI    E,(B)-1         ; POINT TO SLOT
2753         MOVE    B,-3(P)         ; RESTORE TYPE WORD
2754         EXCH    A,B
2755         SOS     D,-1(P)         ; GET ELEMENT #
2756         XCT     (E)             ; SMASH IT BACK
2757         FATAL TEMPLATE LOSSAGE
2758         MOVE    C,-4(P)         ; RESTORE POINTER IN CASE MUNGED
2759         JRST    TD.MR2
2760
2761 TD.MR1: MOVE    A,-8(P)         ; PTR TO DOPE WORD
2762         MOVE    E,-7(P)         ; RESTORE PTR TO FRONTEIR
2763         SUB     P,[7,,7]        ; CLEAN UP STACK
2764 USRAG1: ADDI    A,1             ; POINT TO SECOND D.W.
2765         MOVSI   D,400000        ; SET UP MARK BIT
2766         PUSHJ   P,ADPMOD
2767         PUSHJ   P,TRBLK         ; SEND IT OUT
2768 TMPREL: SUB     P,[1,,1]
2769         HRRZ    D,(A)
2770         SUBI    D,(A)
2771         ADDM    D,(P)
2772         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT
2773         JRST    GCRET
2774
2775 USRAGC: HRRZ    E,(E)           ; MARK THE TEMPLATE
2776         PUSHJ   P,(E)
2777         MOVE    A,-1(P)         ; POINTER TO D.W
2778         MOVE    E,(P)           ; TOINTER TO FRONTIER
2779         JRST    USRAG1
2780
2781 ;  This phase attempts to remove any unwanted associations.  The program
2782 ; loops through the structure marking values of associations.  It can only
2783 ; stop when no new values (potential items and/or indicators) are marked.
2784
2785 VALFLS: PUSH    P,LPVP          ; SAVE LPVP FOR LATER
2786         PUSH    P,[0]           ; INDICATE WHETHER ANY ON THIS PASS
2787         PUSH    P,[0]           ; OR THIS BUCKET
2788 ASOMK1: MOVE    A,GCASOV        ; GET VECTOR POINTER
2789         SETOM   -1(P)           ; INITIALIZE FLAG
2790
2791 ASOM6:  SKIPG   C,(A)           ; SKIP IF BUCKET TO BE SCANNED
2792         JRST    ASOM1
2793         SETOM   (P)             ; SAY BUCKET NOT CHANGED
2794
2795 ASOM2:  MOVEI   F,(C)           ; COPY POINTER
2796         SKIPG   ASOLNT+1(C)     ; SKIP IF NOT ALREADY MARKED
2797         JRST    ASOM4           ; MARKED, GO ON
2798         PUSHJ   P,MARKQ         ; SEE IF ITEM IS MARKED
2799         JRST    ASOM3           ; IT IS NOT, IGNORE IT
2800         MOVEI   F,(C)           ; IN CASE CLOBBERED BY MARK2
2801         MOVEI   C,INDIC(C)              ; POINT TO INDICATOR SLOT
2802         PUSHJ   P,MARKQ
2803         JRST    ASOM3           ; NOT MARKED
2804
2805         PUSH    P,A             ; HERE TO MARK VALUE
2806         PUSH    P,F
2807         HLRE    F,ASOLNT-INDIC+1(C)     ; GET LENGTH
2808         JUMPL   F,.+3           ; SKIP IF MARKED
2809         CAMGE   C,VECBOT        ; SKIP IF IN VECT SPACE
2810         JRST    ASOM20
2811         HRRM    FPTR,ASOLNT-INDIC+1(C)  ; PUT IN RELATIVISATION
2812         MOVEI   F,12            ; AMOUNT TO ALLOCATE IN INF
2813         PUSHJ   P,ALLOGC
2814         HRRM    0,5(C)          ; STICK IN RELOCATION
2815
2816 ASOM20: PUSHJ   P,MARK2         ; AND MARK
2817         MOVEM   A,1(C)          ; LIST FIX UP
2818         ADDI    C,ITEM-INDIC    ; POINT TO ITEM
2819         PUSHJ   P,MARK2
2820         MOVEM   A,1(C)
2821         ADDI    C,VAL-ITEM      ; POINT TO VALUE
2822         PUSHJ   P,MARK2
2823         MOVEM   A,1(C)
2824         IORM    D,ASOLNT-VAL+1(C)       ; MARK ASOC BLOCK
2825         POP     P,F
2826         POP     P,A
2827         AOSA    -1(P)           ; INDICATE A MARK TOOK PLACE
2828
2829 ASOM3:  AOS     (P)             ; INDICATE AN UNMARKED IN THIS BUCKET
2830 ASOM4:  HRRZ    C,ASOLNT-1(F)   ; POINT TO NEXT IN BUCKET
2831         JUMPN   C,ASOM2         ; IF NOT EMPTY, CONTINUE
2832         SKIPGE  (P)             ; SKIP IF ANY NOT MARKED
2833         HRROS   (A)             ; MARK BUCKET AS NOT INTERESTING
2834 ASOM1:  AOBJN   A,ASOM6         ; GO TO NEXT BUCKET
2835         TLZE    TYPNT,.ATOM.    ; ANY ATOMS MARKED?
2836         JRST    VALFLA          ; YES, CHECK VALUES
2837 VALFL8:
2838
2839 ; NOW SEE WHICH CHANNELS STILL POINTED TO
2840
2841 CHNFL3: MOVEI   0,N.CHNS-1
2842         MOVEI   A,CHNL1 ; SLOTS
2843         HRLI    A,TCHAN         ; TYPE HERE TOO
2844
2845 CHNFL2: SKIPN   B,1(A)
2846         JRST    CHNFL1
2847         HLRE    C,B
2848         SUBI    B,(C)           ; POINT TO DOPE
2849         HLLM    A,(A)           ; PUT TYPE BACK
2850         HRRE    F,(A)           ; SEE IF ALREADY MARKED
2851         JUMPN   F,CHNFL1
2852         SKIPGE  1(B)
2853         JRST    CHNFL8
2854         HLLOS   (A)             ; MARK AS A LOSER
2855         SETZM   -1(P)
2856         JRST    CHNFL1
2857 CHNFL8: MOVEI   F,1     ; MARK A GOOD CHANNEL
2858         HRRM    F,(A)
2859 CHNFL1: ADDI    A,2
2860         SOJG    0,CHNFL2
2861
2862         SKIPE   GCHAIR          ; IF NOT HAIRY CASE
2863         POPJ    P,              ; LEAVE
2864
2865         SKIPL   -1(P)           ; SKIP IF NOTHING NEW MARKED
2866         JRST    ASOMK1
2867
2868         SUB     P,[2,,2]        ; REMOVE FLAGS
2869
2870
2871
2872 ; HERE TO REEMOVE UNUSED ASSOCIATIONS
2873
2874         MOVE    A,GCASOV        ; GET ASOVEC BACK FOR FLUSHES
2875
2876 ASOFL1: SKIPN   C,(A)           ; SKIP IF BUCKET NOT EMPTY
2877         JRST    ASOFL2          ; EMPTY BUCKET, IGNORE
2878         HRRZS   (A)             ; UNDO DAMAGE OF BEFORE
2879
2880 ASOFL5: SKIPGE  ASOLNT+1(C)     ; SKIP IF UNMARKED
2881         JRST    ASOFL6          ; MARKED, DONT FLUSH
2882
2883         HRRZ    B,ASOLNT-1(C)   ; GET FORWARD POINTER
2884         HLRZ    E,ASOLNT-1(C)   ; AND BACK POINTER
2885         JUMPN   E,ASOFL4        ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)
2886         HRRZM   B,(A)           ; FIX BUCKET
2887         JRST    .+2
2888
2889 ASOFL4: HRRM    B,ASOLNT-1(E)   ; FIX UP PREVIOUS
2890         JUMPE   B,.+2           ; JUMP IF NO NEXT POINTER
2891         HRLM    E,ASOLNT-1(B)   ; FIX NEXT'S BACK POINTER
2892         HRRZ    B,NODPNT(C)     ; SPLICE OUT THRAD
2893         HLRZ    E,NODPNT(C)
2894         SKIPE   E
2895         HRRM    B,NODPNT(E)
2896         SKIPE   B
2897         HRLM    E,NODPNT(B)
2898
2899 ASOFL3: HRRZ    C,ASOLNT-1(C)   ; GO TO NEXT
2900         JUMPN   C,ASOFL5
2901 ASOFL2: AOBJN   A,ASOFL1
2902
2903
2904 \f
2905 ; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES
2906
2907         MOVE    A,GCGBSP        ; GET GLOBAL PDL
2908
2909 GLOFLS: SKIPGE  (A)             ; SKIP IF NOT ALREADY MARKED
2910         JRST    SVDCL
2911         MOVSI   B,-3
2912         PUSHJ   P,ZERSLT        ; CLOBBER THE SLOT
2913         HLLZS   (A)
2914 SVDCL:  ANDCAM  D,(A)           ; UNMARK
2915         ADD     A,[4,,4]
2916         JUMPL   A,GLOFLS        ; MORE?, KEEP LOOPING
2917
2918         MOVEM   LPVP,(P)
2919 LOCFL1: HRRZ    A,(LPVP)        ; NOW CLOBBER LOCAL SLOTS
2920         HRRZ    C,2(LPVP)
2921         MOVEI   LPVP,(C)
2922         JUMPE   A,LOCFL2        ; NONE TO FLUSH
2923
2924 LOCFLS: SKIPGE  (A)             ; MARKDE?
2925         JRST    .+3
2926         MOVSI   B,-5
2927         PUSHJ   P,ZERSLT
2928         ANDCAM  D,(A)           ;UNMARK
2929         HRRZ    A,(A)           ; GO ON
2930         JUMPN   A,LOCFLS
2931 LOCFL2: JUMPN   LPVP,LOCFL1     ; JUMP IF MORE PROCESS
2932
2933 ; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT.
2934 ; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING.  IT FIXES UP THE SP-CHAIN AND IT
2935 ; SENDS OUT THE ATOMS.
2936
2937 LOCFL3: MOVE    C,(P)
2938         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
2939         PUSHJ   P,MARK1         ; MARK THE ATOM
2940         MOVEM   A,1(C)          ; NEW HOME
2941         MOVEI   C,2(C)          ; MARK VALUE
2942         MOVEI   B,TPVP          ; IT IS A PROCESS VECTOR POINTER
2943         PUSHJ   P,MARK1         ; MARK IT
2944         MOVEM   A,1(C)
2945         POP     P,R
2946 NEXPRO: MOVEI   0,TPVP          ; FIX UP SLOT
2947         HLRZ    A,2(R)          ; GET PTR TO NEXT PROCESS
2948         HRLM    0,2(R)
2949         HRRZ    E,(A)           ; ADRESS IN INF
2950         HRRZ    B,(A)           ; CALCULATE RELOCATION
2951         SUB     B,A
2952         PUSH    P,B
2953         HRRZ    F,A             ; CALCULATE START OF TP IN F
2954         HLRZ    B,(A)           ; ADJUST INF PTR
2955         TRZ     B,400000
2956         SUBI    F,-1(B)
2957         LDB     M,[111100,,-1(A)]       ; CALCULATE TOP GROWTH
2958         TRZE    M,400           ; FUDGE SIGN
2959         MOVNS   M
2960         ASH     M,6
2961         ADD     B,M             ; FIX UP LENGTH
2962         EXCH    M,(P)
2963         SUBM    M,(P)           ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH
2964         MOVE    M,R             ; GET A COPY OF R
2965 NEXP1:  HRRZ    C,(M)           ; GET PTR TO NEXT IN CHAIN
2966         JUMPE   C,NEXP2         ; EXIT IF END OF CHAIN
2967         MOVE    0,C             ; GET COPY OF CHAIN PTR TO UPDATE
2968         ADD     0,(P)           ; UPDATE
2969         HRRM    0,(M)           ; PUT IN
2970         MOVE    M,C             ; NEXT
2971         JRST    NEXP1
2972 NEXP2:  SUB     P,[1,,1]        ; CLEAN UP STACK
2973         SUBI    E,-1(B)
2974         HRRI    B,(R)           ; GET POINTER TO THIS-PROCESS BINDING
2975         MOVEI   B,6(B)          ; POINT AFTER THE BINDING
2976         MOVE    0,F             ; CALCULATE # OF WORDS TO SEND OUT
2977         SUBM    B,0
2978         PUSH    P,R             ; PRESERVE R
2979         PUSHJ   P,TRBLKX                ; SEND IT OUT
2980         POP     P,R             ; RESTORE R
2981         HRRZS   R,2(R)          ; GET THE NEXT PROCESS
2982         SKIPN   R
2983         JRST    .+3
2984         PUSH    P,R
2985         JRST    LOCFL3
2986         MOVE    A,GCGBSP        ; PTR TO GLOBAL STACK
2987         PUSHJ   P,SPCOUT        ; SEND IT OUT
2988         MOVE    A,GCASOV
2989         PUSHJ   P,SPCOUT        ; SEND IT OUT
2990         POPJ    P,
2991
2992 ; THIS ROUTINE MARKS ALL THE CHANNELS
2993 ; IT THEN SENDS OUT A COPY OF THE TVP
2994
2995 CHFIX:  MOVEI   0,N.CHNS-1
2996         MOVEI   A,CHNL1         ; SLOTS
2997         HRLI    A,TCHAN         ; TYPE HERE TOO
2998
2999 DHNFL2: SKIPN   B,1(A)
3000         JRST    DHNFL1
3001         MOVEI   C,(A)           ; MARK THE CHANNEL
3002         PUSH    P,0             ; SAVE 0
3003         PUSH    P,A             ; SAVE A
3004         PUSHJ   P,MARK2
3005         MOVEM   A,1(C)          ; ADJUST PTR
3006         POP     P,A             ; RESTORE A
3007         POP     P,0             ; RESTORE
3008 DHNFL1: ADDI    A,2
3009         SOJG    0,DHNFL2
3010         POPJ    P,
3011
3012
3013 ; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR
3014
3015 SPCOUT: HLRE    B,A
3016         SUB     A,B
3017         MOVEI   A,1(A)          ; POINT TO DOPE WORD
3018         LDB     0,[001100,,-1(A)]       ;GET GROWTH FACTOR
3019         TRZE    0,400           ;KILL SIGN BIT AND SKIP IF +
3020         MOVNS   0               ;NEGATE
3021         ASH     0,6             ;CONVERT TO NUMBER OF WORDS
3022         PUSHJ   P,DOPMOD
3023         HRRZ    E,(A)           ; GET PTR TO INF
3024         HLRZ    B,(A)           ; LENGTH
3025         TRZ     B,400000        ; GET RID OF MARK BIT
3026         SUBI    E,-1(B)
3027         ADD     E,0
3028         PUSH    P,0             ; DUMMY FOR TRBLKV
3029         PUSHJ   P,TRBLKV        ; OUT IT GOES
3030         SUB     P,[1,,1]
3031         POPJ    P,              ;RETURN
3032
3033 ASOFL6: HLRZ    E,ASOLNT-1(C)   ; SEE IF FIRST IN BUCKET
3034         JUMPN   E,ASOFL3        ; IF NOT CONTINUE
3035         HRRZ    E,ASOLNT+1(C)   ; GET PTR FROM DOPE WORD
3036         SUBI    E,ASOLNT+1      ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION
3037         HRRZM   E,(A)           ; SMASH IT IN
3038         JRST    ASOFL3
3039
3040
3041 MARK23: PUSH    P,A             ; SAVE BUCKET POINTER
3042         PUSH    P,F
3043         PUSHJ   P,MARK2
3044         MOVEM   A,1(C)
3045         POP     P,F
3046         POP     P,A
3047         AOS     -2(P)           ; MARKING HAS OCCURRED
3048         IORM    D,ASOLNT+1(C)   ; MARK IT
3049         JRST    MKD
3050
3051 \f; CHANNEL FLUSHER FOR NON HAIRY GC
3052
3053 CHNFLS: PUSH    P,[-1]
3054         SETOM   (P)             ; RESET FOR RETRY
3055         PUSHJ   P,CHNFL3
3056         SKIPL   (P)
3057         JRST    .-3             ; REDO
3058         SUB     P,[1,,1]
3059         POPJ    P,
3060
3061 ; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP
3062
3063 VALFLA: MOVE    C,GCGBSP        ; GET POINTER TO GLOBAL STACK
3064 VALFL1: SKIPL   (C)             ; SKIP IF NOT MARKED
3065         PUSHJ   P,MARKQ         ; SEE IF ATOM IS MARKED
3066         JRST    VALFL2
3067         PUSH    P,C
3068         MOVEI   B,TATOM         ; UPDATE ATOM SLOT
3069         PUSHJ   P,MARK1
3070         MOVEM   A,1(C)
3071         IORM    D,(C)
3072         AOS     -2(P)           ; INDICATE MARK OCCURRED
3073         HRRZ    B,(C)           ; GET POSSIBLE GDECL
3074         JUMPE   B,VLFL10        ; NONE
3075         CAIN    B,-1            ; MAINFIFEST
3076         JRST    VLFL10
3077         MOVEI   A,(B)
3078         MOVEI   B,TLIST
3079         MOVEI   C,0
3080         PUSHJ   P,MARK          ; MARK IT
3081         MOVE    C,(P)           ; POINT
3082         HRRM    A,(C)           ; CLOBBER UPDATE IN
3083 VLFL10: ADD     C,[2,,2]        ; BUMP TO VALUE
3084         PUSHJ   P,MARK2         ; MARK VALUE
3085         MOVEM   A,1(C)
3086         POP     P,C
3087 VALFL2: ADD     C,[4,,4]
3088         JUMPL   C,VALFL1        ; JUMP IF MORE
3089
3090         HRLM    LPVP,(P)        ; SAVE POINTER
3091 VALFL7: MOVEI   C,(LPVP)
3092         MOVEI   LPVP,0
3093 VALFL6: HRRM    C,(P)
3094
3095 VALFL5: HRRZ    C,(C)           ; CHAIN
3096         JUMPE   C,VALFL4
3097         MOVEI   B,TATOM         ; TREAT LIKE AN ATOM
3098         SKIPL   (C)             ; MARKED?
3099         PUSHJ   P,MARKQ1        ; NO, SEE
3100         JRST    VALFL5          ; LOOP
3101         AOS     -1(P)           ; MARK WILL OCCUR
3102         MOVEI   B,TATOM         ; RELATAVIZE
3103         PUSHJ   P,MARK1
3104         MOVEM   A,1(C)
3105         IORM    D,(C)
3106         ADD     C,[2,,2]        ; POINT TO VALUE
3107         PUSHJ   P,MARK2         ; MARK VALUE
3108         MOVEM   A,1(C)
3109         SUBI    C,2
3110         JRST    VALFL5
3111
3112 VALFL4: HRRZ    C,(P)           ; GET SAVED LPVP
3113         MOVEI   A,(C)
3114         HRRZ    C,2(C)          ; POINT TO NEXT
3115         JUMPN   C,VALFL6
3116         JUMPE   LPVP,VALFL9
3117
3118         HRRM    LPVP,2(A)       ; NEW PROCESS WAS MARKED
3119         JRST    VALFL7
3120
3121 ZERSLT: HRRI    B,(A)           ; COPY POINTER
3122         SETZM   1(B)
3123         AOBJN   B,.-1
3124         POPJ    P,
3125
3126 VALFL9: HLRZ    LPVP,(P)        ; RESTORE CHAIN
3127         JRST    VALFL8
3128
3129 \f;SUBROUTINE TO SEE IF A GOODIE IS MARKED
3130 ;RECEIVES POINTER IN C
3131 ;SKIPS IF MARKED NOT OTHERWISE
3132
3133 MARKQ:  HLRZ    B,(C)           ;TYPE TO B
3134 MARKQ1: MOVE    E,1(C)          ;DATUM TO C
3135         MOVEI   0,(E)
3136         CAIL    0,@PURBOT       ; DONT CHACK PURE
3137         JRST    MKD             ; ALWAYS MARKED
3138         ANDI    B,TYPMSK        ; FLUSH MONITORS
3139         LSH     B,1
3140         HRRZ    B,@TYPNT        ;GOBBLE SAT
3141         ANDI    B,SATMSK
3142         CAIG    B,NUMSAT        ; SKIP FOR TEMPLATE
3143         JRST    @MQTBS(B)       ;DISPATCH
3144         ANDI    E,-1            ; FLUSH REST HACKS
3145         JRST    VECMQ
3146
3147
3148 MQTBS:
3149
3150 OFFSET 0
3151
3152 DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
3153 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ]
3154 [SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]
3155 [SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ]
3156 [SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]]
3157
3158 OFFSET OFFS
3159
3160 PAIRMQ: JUMPE   E,MKD           ; NIL ALWAYS MARKED
3161         SKIPL   (E)             ; SKIP IF MARKED
3162         POPJ    P,
3163 ARGMQ:
3164 MKD:    AOS     (P)
3165         POPJ    P,
3166
3167 BYTMQ:  PUSH    P,A             ; SAVE A
3168         PUSHJ   P,BYTDOP                ; GET PTR TO DOPE WORD
3169         MOVE    E,A             ; COPY POINTER
3170         POP     P,A             ; RESTORE A
3171         SKIPGE  (E)             ; SKIP IF NOT MARKED
3172         AOS     (P)
3173         POPJ    P,              ; EXIT
3174
3175 FRMQ:   HRRZ    E,(C)           ; POINT TO PV DOPE WORD
3176         SOJA    E,VECMQ1
3177
3178 ATMMQ:  CAML    0,GCSBOT        ; ALWAYS KEEP FROZEN ATOMS
3179         JRST    VECMQ
3180         AOS     (P)
3181         POPJ    P,
3182
3183 VECMQ:  HLRE    0,E             ;GET LENGTH
3184         SUB     E,0             ;POINT TO DOPE WORDS
3185
3186 VECMQ1: SKIPGE  1(E)            ;SKIP IF NOT MARKED
3187         AOS     (P)             ;MARKED, CAUSE SKIP RETURN
3188         POPJ    P,
3189
3190 ASMQ:   ADDI    E,ASOLNT
3191         JRST    VECMQ1
3192
3193 LOCMQ:  HRRZ    0,(C)           ; GET TIME
3194         JUMPE   0,VECMQ         ; GLOBAL, LIKE VECTOR
3195         HLRE    0,E             ; FIND DOPE
3196         SUB     E,0
3197         MOVEI   E,1(E)          ; POINT TO LAST DOPE
3198         CAMN    E,TPGROW                ; GROWING?
3199         SOJA    E,VECMQ1        ; YES, CHECK
3200         ADDI    E,PDLBUF        ; FUDGE
3201         MOVSI   0,-PDLBUF
3202         ADDM    0,1(C)
3203         SOJA    E,VECMQ1
3204
3205 OFFSMQ: HLRZS   E               ; POINT TO LIST STRUCTURE
3206         SKIPGE  (E)             ; MARKED?
3207          AOS    (P)             ; YES
3208         POPJ    P,
3209
3210 \f; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF
3211
3212 ASSOUP: MOVE    A,GCNOD         ; RECOVER PTR TO START OF CHAIN
3213 ASSOP1: HRRZ    B,NODPNT(A)
3214         PUSH    P,B             ; SAVE NEXT ON CHAIN
3215         PUSH    P,A             ; SAVE IT
3216         HRRZ    B,ASOLNT-1(A)   ;POINT TO NEXT
3217         JUMPE   B,ASOUP1
3218         HRRZ    C,ASOLNT+1(B)   ;AND GET ITS RELOC IN C
3219         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
3220         ADDM    C,ASOLNT-1(A)   ;C NOW HAS UPDATED POINTER
3221 ASOUP1: HLRZ    B,ASOLNT-1(A)   ;GET PREV BLOCK POINTER
3222         JUMPE   B,ASOUP2
3223         HRRZ    F,ASOLNT+1(B)   ;AND ITS RELOCATION
3224         SUBI    F,ASOLNT+1(B)   ; RELATIVIZE
3225         MOVSI   F,(F)
3226         ADDM    F,ASOLNT-1(A)   ;RELOCATE
3227 ASOUP2: HRRZ    B,NODPNT(A)             ;UPDATE NODE CHAIN
3228         JUMPE   B,ASOUP4
3229         HRRZ    C,ASOLNT+1(B)           ;GET RELOC
3230         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
3231         ADDM    C,NODPNT(A)     ;AND UPDATE
3232 ASOUP4: HLRZ    B,NODPNT(A)     ;GET PREV POINTER
3233         JUMPE   B,ASOUP5
3234         HRRZ    F,ASOLNT+1(B)   ;RELOC
3235         SUBI    F,ASOLNT+1(B)
3236         MOVSI   F,(F)
3237         ADDM    F,NODPNT(A)
3238 ASOUP5: POP     P,A             ; RECOVER PTR TO DOPE WORD
3239         MOVEI   A,ASOLNT+1(A)
3240         MOVSI   B,400000        ;UNMARK IT
3241         XORM    B,(A)
3242         HRRZ    E,(A)           ; SET UP PTR TO INF
3243         HLRZ    B,(A)
3244         SUBI    E,-1(B)         ; ADJUST PTR
3245         PUSHJ   P,ADPMOD
3246         PUSHJ   P,TRBLK         ; OUT IT GOES
3247         POP     P,A             ; RECOVER PTR TO ASSOCIATION
3248         JUMPN   A,ASSOP1        ; IF NOT ZERO CONTINUP
3249         POPJ    P,              ; DONE
3250
3251 \f
3252 ; HERE TO CLEAN UP ATOM HASH TABLE
3253
3254 ATCLEA: MOVE    A,GCHSHT        ; GET TABLE POINTER
3255
3256 ATCLE1: MOVEI   B,0
3257         SKIPE   C,(A)           ; GET NEXT
3258         JRST    ATCLE2          ; GOT ONE
3259
3260 ATCLE3: PUSHJ   P,OUTATM
3261         AOBJN   A,ATCLE1
3262
3263         MOVE    A,GCHSHT        ; MOVE OUT TABLE
3264         PUSHJ   P,SPCOUT
3265         POPJ    P,
3266
3267 ; HAVE AN ATOM IN C
3268
3269 ATCLE2: MOVEI   B,0
3270
3271 ATCLE5: CAIL    C,HIBOT
3272         JRST    ATCLE3
3273         CAMG    C,VECBOT        ; FROZEN ATOMS ALWAYS MARKED
3274          JRST   .+3
3275         SKIPL   1(C)            ; SKIP IF ATOM MARKED
3276         JRST    ATCLE6
3277
3278         HRRZ    0,1(C)          ; GET DESTINATION
3279         CAIN    0,-1            ; FROZEN/MAGIC ATOM
3280          MOVEI  0,1(C)          ; USE CURRENT POSN
3281         SUBI    0,1             ; POINT TO CORRECT DOPE
3282         JUMPN   B,ATCLE7        ; JUMP IF GOES INTO ATOM
3283
3284         HRRZM   0,(A)           ; INTO HASH TABLE
3285         JRST    ATCLE8
3286
3287 ATCLE7: HRLM    0,2(B)          ; INTO PREV ATOM
3288         PUSHJ   P,OUTATM
3289
3290 ATCLE8: HLRZ    B,1(C)
3291         ANDI    B,377777        ; KILL MARK BIT
3292         SUBI    B,2
3293         HRLI    B,(B)
3294         SUBM    C,B
3295         HLRZ    C,2(B)
3296         JUMPE   C,ATCLE3        ; DONE WITH BUCKET
3297         JRST    ATCLE5
3298
3299 ; HERE TO PASS OVER LOST ATOM
3300
3301 ATCLE6: HLRZ    F,1(C)          ; FIND NEXT ATOM
3302         SUBI    C,-2(F)
3303         HLRZ    C,2(C)
3304         JUMPE   B,ATCLE9
3305         HRLM    C,2(B)
3306         JRST    .+2
3307 ATCLE9: HRRZM   C,(A)
3308         JUMPE   C,ATCLE3
3309         JRST    ATCLE5
3310
3311 OUTATM: JUMPE   B,CPOPJ
3312         PUSH    P,A
3313         PUSH    P,C
3314         HLRE    A,B
3315         SUBM    B,A
3316         MOVSI   D,400000        ;UNMARK IT
3317         XORM    D,1(A)
3318         HRRZ    E,1(A)          ; SET UP PTR TO INF
3319         HLRZ    B,1(A)
3320         SUBI    E,-1(B)         ; ADJUST PTR
3321         MOVEI   A,1(A)
3322         PUSHJ   P,ADPMOD
3323         PUSHJ   P,TRBLK         ; OUT IT GOES
3324         POP     P,C
3325         POP     P,A             ; RECOVER PTR TO ASSOCIATION
3326         POPJ    P,
3327
3328 \f
3329 VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH
3330
3331
3332 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
3333
3334 MSGGCT: [ASCIZ /USER CALLED- /]
3335         [ASCIZ /FREE STORAGE- /]
3336         [ASCIZ /TP-STACK- /]
3337         [ASCIZ /TOP-LEVEL LOCALS- /]
3338         [ASCIZ /GLOBAL VALUES- /]
3339         [ASCIZ /TYPES- /]
3340         [ASCIZ /STATIONARY IMPURE STORAGE- /]
3341         [ASCIZ /P-STACK /]
3342         [ASCIZ /BOTH STACKS BLOWN- /]
3343         [ASCIZ /PURE STORAGE- /]
3344         [ASCIZ /GC-RCALL- /]
3345
3346 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
3347
3348 GCPAT:  SPBLOK 100
3349 EGCPAT: -1
3350
3351 MSGGFT: [ASCIZ /GC-READ /]
3352         [ASCIZ /BLOAT /]
3353         [ASCIZ /GROW /]
3354         [ASCIZ /LIST /]
3355         [ASCIZ /VECTOR /]
3356         [ASCIZ /SET /]
3357         [ASCIZ /SETG /]
3358         [ASCIZ /FREEZE /]
3359         [ASCIZ /PURE-PAGE LOADER /]
3360         [ASCIZ /GC /]
3361         [ASCIZ /INTERRUPT-HANDLER /]
3362         [ASCIZ /NEWTYPE /]
3363         [ASCIZ /PURIFY /]
3364
3365 .GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL
3366 .GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX
3367 .GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP
3368 .GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB
3369 .GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG
3370 .GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN
3371 .GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR
3372
3373 \f
3374 ;LOCAL VARIABLES
3375
3376 OFFSET 0
3377
3378 IMPURE
3379 ; LOCACTIONS USED BY THE PAGE HACKER
3380
3381 DOPSV1: 0                       ;SAVED FIRST D.W.
3382 DOPSV2: 0                       ; SAVED LENGTH
3383
3384
3385 ; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS.
3386 ;
3387
3388 GCNO:   0                       ; USER-CALLED GC
3389 BSTGC:  0                       ; FREE STORAGE
3390         0                       ; BLOWN TP
3391         0                       ; TOP-LEVEL LVALS
3392         0                       ; GVALS
3393         0                       ; TYPE
3394         0                       ; STORAGE
3395         0                       ; P-STACK
3396         0                       ; BOTH STATCKS BLOWN
3397         0                       ; STORAGE
3398
3399 BSTAT:
3400 NOWFRE: 0                       ; FREE STORAGE FROM LAST GC
3401 CURFRE: 0                       ; STORAGE USED SINCE LAST GC
3402 MAXFRE: 0                       ; MAXIMUM FREE STORAGE ALLOCATED
3403 USEFRE: 0                       ; TOTAL FREE STORAGE USED
3404 NOWTP:  0                       ; TP LENGTH FROM LAST GC
3405 CURTP:  0                       ; # WORDS ON TP
3406 CTPMX:  0                       ; MAXIMUM SIZE OF TP SO FAR
3407 NOWLVL: 0                       ; # OF TOP-LEVEL LVAL-SLOTS
3408 CURLVL: 0                       ; # OF TOP-LEVEL LVALS
3409 NOWGVL: 0                       ; # OF GVAL SLOTS
3410 CURGVL: 0                       ; # OF GVALS
3411 NOWTYP: 0                       ; SIZE OF TYPE-VECTOR
3412 CURTYP: 0                       ; # OF TYPES
3413 NOWSTO: 0                       ; SIZE OF STATIONARY STORAGE
3414 CURSTO: 0                       ; STATIONARY STORAGE IN USE
3415 CURMAX: 0                       ; MAXIMUM BLOCK OF  CONTIGUOUS STORAGE
3416 NOWP:   0                       ; SIZE OF P-STACK
3417 CURP:   0                       ; #WORDS ON P
3418 CPMX:   0                       ; MAXIMUM P-STACK LENGTH SO FAR
3419 GCCAUS: 0                       ; INDICATOR FOR CAUSE OF GC
3420 GCCALL: 0                       ; INDICATOR FOR CALLER OF GC
3421
3422
3423 ; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW
3424 LVLINC: 6                       ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS
3425 GVLINC: 4                       ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS
3426 TYPIC:  1                       ; TYPE INCREMENT ASSUMED TO BE 32 TYPES
3427 STORIC: 2000                    ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE)
3428
3429
3430 RCL:    0                       ; POINTER TO LIST OF RECYCLEABLE LIST CELLS
3431 RCLV:   0                       ; POINTER TO RECYCLED VECTORS
3432 GCMONF: 0                       ; NON-ZERO SAY GIN/GOUT
3433 GCDANG: 0                       ; NON-ZERO, STORAGE IS LOW
3434 INBLOT: 0                       ; INDICATE THAT WE ARE RUNNING OIN A BLOAT
3435 GETNUM: 0                       ;NO OF WORDS TO GET
3436 RFRETP:
3437 RPTOP:  0                       ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
3438 CORTOP: 0                       ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
3439 NGCS:   8                       ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS
3440
3441 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
3442 ;AND WHEN IT WILL GET UNHAPPY
3443
3444 FREMIN: 20000                   ;MINIMUM FREE WORDS
3445
3446 ;POINTER TO GROWING PDL
3447
3448 TPGROW: 0                       ;POINTS TO A BLOWN TP
3449 PPGROW: 0                       ;POINTS TO A BLOWN PP
3450 PGROW:  0                       ;POINTS TO A BLOWN P
3451
3452 ;IN GC FLAG
3453
3454 GCFLG:  0
3455 GCFLCH: 0               ; TELL INT HANDLER TO ITIC CHARS
3456 GCHAIR: 1               ; COUNTS GCS AND TELLS WHEN TO HAIRIFY
3457 GCDOWN: 0               ; AMOUNT TO TRY AND MOVE DOWN
3458 CURPLN: 0               ; LENGTH OF CURRENTLY RUNNING PURE RSUBR
3459 PURMIN: 0               ; MINIMUM PURE STORAGE
3460
3461 ; VARS ASSOCIATED WITH BLOAT LOGIC
3462 PMIN:   200                     ; MINIMUM FOR PSTACK
3463 PGOOD:  1000                    ; GOOD SIZE FOR PSTACK
3464 PMAX:   4000                    ; MAX SIZE FOR PSTACK
3465 TPMIN:  1000                    ; MINIMUM SIZE FOR TP
3466 TPGOOD: NTPGOO                  ; GOOD SIZE OF TP
3467 TPMAX:  NTPMAX                  ; MAX SIZE OF TP
3468
3469 TPBINC: 0
3470 GLBINC: 0
3471 TYPINC: 0
3472
3473 ; VARS FOR PAGE WINDOW HACKS
3474
3475 GCHSHT: 0                       ; SAVED ATOM TABLE
3476 PURSVT: 0                       ; SAVED PURVEC TABLE
3477 GLTOP:  0                       ; SAVE GLOTOP
3478 GCNOD:  0                       ; PTR TO START OF ASSOCIATION CHAIN
3479 GCGBSP: 0                       ; SAVED GLOBAL SP
3480 GCASOV: 0                       ; SAVED PTR TO ASSOCIATION VECTOR
3481 GCATM:  0                       ; PTR TO IMQUOT THIS-PROCESS
3482 FNTBOT: 0                       ; BOTTOM OF FRONTEIR
3483 WNDBOT: 0                       ; BOTTOM OF WINDOW
3484 WNDTOP: 0
3485 BOTNEW: (FPTR)                  ; POINTER TO FRONTIER
3486 GCTIM:  0
3487 NPARBO: 0                       ; SAVED PARBOT
3488
3489 ; FLAGS TO INDICATE DUMPER IS  IN USE
3490
3491 GPURFL: 0                       ; INDICATE PURIFIER IS RUNNING
3492 GCDFLG: 0                       ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING
3493 DUMFLG: 0                       ; FLAG INDICATING DUMPER IS RUNNING
3494
3495 ; CONSTANTS FOR DUMPER,READER AND PURIFYER
3496
3497 ABOTN:  0               ; COUNTER FOR ATOMS
3498 NABOTN: 0               ; POINTER USED BY PURIFY
3499 OGCSTP: 0               ; CONTAINS OLD GCSTOP FOR READER
3500 MAPUP:  0               ; BEGINNING OF MAPPED UP PURE STUFF
3501 SAVRES: 0               ; SAVED UPDATED ITEM OF PURIFIER
3502 SAVRE2: 0               ; SAVED TYPE WORD
3503 SAVRS1: 0               ; SAVED PTR TO OBJECT
3504 INF1:   0               ; AOBJN PTR USED IN CREATING PROTECTION INF
3505 INF2:   0               ; AOBJN PTR USED IN CREATING SECOND INF
3506 INF3:   0               ; AOBJN PTR USED TO PURIFY A STRUCTURE
3507
3508 ; VARIABLES USED BY GC INTERRUPT HANDLER
3509
3510 GCHPN:  0               ; SET TO -1 EVERYTIME A GC HAS OCCURED
3511 GCKNUM: 0               ; NUMBER OF WORDS OF REQUEST TO INTERRUPT
3512
3513 ; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN
3514
3515 PSHGCF: 0
3516
3517 ; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES
3518
3519 TYPTAB: 0               ; POINTER TO TYPE TABLE
3520 NNPRI:  0               ; NUMPRI FROM DUMPED OBJECT
3521 NNSAT:  0               ; NUMSAT FROM DUMPED OBJECT
3522 TYPSAV: 0               ; SAVE PTR TO TYPE VECTOR
3523
3524 ; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING
3525
3526 BUFGC:  0               ; BUFFER FOR COPY ON WRITE HACKING
3527 PURMNG: 0               ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP
3528 RPURBT: 0               ; SAVED VALUE OF PURTOP
3529 RGCSTP: 0               ; SAVED GCSTOP
3530
3531 ; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO
3532
3533 INCORF: 0                       ; INDICATION OF UVECTOR HACKS FOR GC-DUMP
3534 PURCOR: 0                       ; INDICATION OF UVECTOR TO PURE CORE
3535                                 ; ARE NOT GENERATED
3536
3537
3538 PLODR:  0                       ; INDICATE A PLOAD IS IN OPERATION
3539 NPRFLG: 0
3540
3541 ; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR
3542
3543 MAXLEN: 0                       ; MAXIMUM RECLAIMED SLOT
3544
3545 PURE
3546
3547 OFFSET OFFS
3548
3549 CONSTANTS
3550
3551 HERE
3552
3553 CONSTANTS
3554
3555 OFFSET 0
3556
3557 ZZ==$.+1777
3558
3559 .LOP ANDCM ZZ 1777
3560
3561 ZZ1==.LVAL1
3562
3563 LOC ZZ1
3564
3565
3566 OFFSET OFFS
3567
3568 WIND:   SPBLOK  2000
3569 FRONT:  SPBLOK  2000
3570 MRKPD:  SPBLOK  1777
3571 ENDPDL: -1
3572
3573 MRKPDL=MRKPD-1
3574
3575 ENDGC:
3576
3577 OFFSET 0
3578
3579 .LOP <ASH @> WIND <,-10.>
3580 WNDP==.LVAL1
3581
3582 .LOP <ASH @> FRONT <,-10.>
3583 FRNP==.LVAL1
3584
3585 ZZ2==ENDGC-AGCLD
3586 .LOP <ASH @> ZZ2 <,-10.>
3587 LENGC==.LVAL1
3588
3589 .LOP <ASH @> LENGC <,10.>
3590 RLENGC==.LVAL1
3591
3592 .LOP <ASH @> AGCLD <,-10.>
3593 PAGEGC==.LVAL1
3594
3595 OFFSET 0
3596
3597 LOC GCST
3598 .LPUR==$.
3599
3600 END
3601