<mdl.int>/agc.mid.139

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