<mdl.int>/agc.mid.141

   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         SKIPN   INBLOT          ; STORE TIME ONLY IF NO RETRY
1403          SKIPN  GCDANG
1404           MOVEM B,GCTIM         ; SAVE ELAPSED TIME FOR INT-HANDLER
1405         SKIPN   GCMONF          ; SEE IF MONITORING
1406         JRST    GCCONT
1407         PUSHJ   P,FIXSEN        ; OUTPUT TIME
1408         MOVEI   A,15            ; OUTPUT C/R LINE-FEED
1409         PUSHJ   P,IMTYO
1410         MOVEI   A,12
1411         PUSHJ   P,IMTYO
1412 GCCONT: MOVE    C,[NTPGOO,,NTPMAX]      ; MAY FIX UP TP PARAMS TO ENCOURAGE
1413                                         ; SHRINKAGE FOR EXTRA ROOM
1414         SKIPE   GCDANG
1415         MOVE    C,[ETPGOO,,ETPMAX]
1416         HLRZM   C,TPGOOD
1417         HRRZM   C,TPMAX
1418         POP     P,D             ; RESTORE AC'C
1419         POP     P,C
1420         POP     P,B
1421         POP     P,A
1422         MOVE    A,GCDANG
1423         JUMPE   A,AGCWIN                ; IF ZERO THE GC WORKED
1424         SKIPN   GCHAIR          ; SEE IF HAIRY GC
1425         JRST    BTEST
1426 REAGCX: MOVEI   A,1             ; PREPARE FOR A HAIRY GC
1427         MOVEM   A,GCHAIR
1428         SETZM   GCDANG
1429         MOVE    C,[11,,10.]     ; REASON FOR GC
1430         JRST    IAGC
1431
1432 BTEST:  SKIPE   INBLOT
1433         JRST    AGCWIN
1434         FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS
1435         JRST    REAGCX
1436
1437 AGCWIN: SETZM   PARNEW          ;CLEAR FOR NEXT AGC CALL
1438         SETZM   GETNUM          ;ALSO CLEAR THIS
1439         SETZM   INBLOT
1440         SETZM   GCFLG
1441
1442         SETZM   PGROW           ; CLEAR GROWTH
1443         SETZM   TPGROW
1444         SETOM   GCHAPN          ; INDICATE A GC HAS HAPPENED
1445         SETOM   GCHPN
1446         SETOM   INTFLG          ; AND REQUEST AN INTERRUPT
1447         SETZM   GCDOWN
1448         PUSHJ   P,RBLDM
1449 ;       JUMPE   R,FINAGC
1450 ;       JUMPN   M,FINAGC                ; IF M 0, RUNNING RSUBR SWAPPED OUT
1451 ;       SKIPE   PLODR           ; LOADING ONE, M = 0 IS OK
1452          JRST   FINAGC
1453
1454         FATAL AGC--RUNNING RSUBR WENT AWAY
1455
1456 AGCE1:  FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR
1457
1458 \f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
1459 ; POINT.
1460
1461 FIXSEN: PUSH    P,B             ; SAVE TIME
1462         MOVEI   B,[ASCIZ /TIME= /]
1463         PUSHJ   P,MSGTYP        ; PRINT OUT MESSAGE
1464         POP     P,B             ; RESTORE B
1465         FMPRI   B,(100.0)       ; CONVERT TO FIX
1466         MULI    B,400
1467         TSC     B,B
1468         ASH     C,-163.(B)
1469         MOVEI   A,1             ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
1470         PUSH    P,C
1471         IDIVI   C,10.           ; START COUNTING
1472         JUMPLE  C,.+2
1473         AOJA    A,.-2
1474         POP     P,C
1475         CAIN    A,1             ; SEE IF THERE IS ONLY ONE CHARACTER
1476         JRST    DOT1
1477 FIXOUT: IDIVI   C,10.           ; RECOVER NUMBER
1478         HRLM    D,(P)
1479         SKIPE   C
1480         PUSHJ   P,FIXOUT
1481         PUSH    P,A             ; SAVE A
1482         CAIN    A,2             ; DECIMAL POINT HERE?
1483         JRST    DOT2
1484 FIX1:   HLRZ    A,(P)-1         ; GET NUMBER
1485         ADDI    A,60            ; MAKE IT A CHARACTER
1486         PUSHJ   P,IMTYO         ; OUT IT GOES
1487         POP     P,A
1488         SOJ     A,
1489         POPJ    P,
1490 DOT1:   MOVEI   A,".            ; OUTPUT DECIMAL POINT AND PADDING 0
1491         PUSHJ   P,IMTYO
1492         MOVEI   A,"0
1493         PUSHJ   P,IMTYO
1494         JRST    FIXOUT          ; CONTINUE
1495 DOT2:   MOVEI   A,".            ; OUTPUT DECIMAL POINT
1496         PUSHJ   P,IMTYO
1497         JRST    FIX1
1498
1499
1500 \f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
1501
1502 PDLCHK: JUMPGE  A,CPOPJ
1503         HLRE    B,A             ;GET NEGATIVE COUNT
1504         MOVE    C,A             ;SAVE A COPY OF PDL POINTER
1505         SUBI    A,-1(B)         ;LOCATE DOPE WORD PAIR
1506         HRRZS   A               ; ISOLATE POINTER
1507         CAME    A,TPGROW        ;GROWING?
1508         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
1509         MOVMS   B
1510         CAIN    A,2(C)
1511         JRST    NOFENC
1512         SETOM   1(C)            ; START FENECE POST
1513         CAIN    A,3(C)
1514         JRST    NOFENC
1515         MOVSI   D,1(C)          ;YES, SET UP TO BLT FENCE POSTS
1516         HRRI    D,2(C)
1517         BLT     D,-2(A)         ;FENCE POST ALL EXCEPT DOPE WORDS
1518
1519
1520 NOFENC: CAMG    B,TPMAX         ;NOW CHECK SIZE
1521         CAMG    B,TPMIN
1522         JRST    MUNGTP          ;TOO BIG OR TOO SMALL
1523         POPJ    P,
1524
1525 MUNGTP: SUB     B,TPGOOD        ;FIND DELTA TP
1526 MUNG3:  MOVE    C,-1(A)         ;IS GROWTH ALREADY SPECIFIED
1527         TRNE    C,777000        ;SKIP IF NOT
1528         POPJ    P,              ;ASSUME GROWTH GIVEN WILL WIN
1529
1530         ASH     B,-6            ;CONVERT TO NUMBER OF BLOCKS
1531         JUMPLE  B,MUNGT1
1532         CAILE   B,377           ; SKIP IF BELOW MAX
1533         MOVEI   B,377           ; ELSE USE MAX
1534         TRO     B,400           ;TURN ON SHRINK BIT
1535         JRST    MUNGT2
1536 MUNGT1: MOVMS   B
1537         ANDI    B,377
1538 MUNGT2: DPB     B,[111100,,-1(A)]       ;STORE IN DOPE WORD
1539         POPJ    P,
1540
1541 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
1542
1543 PDLCHP: HLRE    B,A             ;-LENGTH TO B
1544         MOVE    C,A
1545         SUBI    A,-1(B)         ;POINT TO DOPE WORD
1546         HRRZS   A               ;ISOLATE POINTER
1547         CAME    A,PGROW         ;GROWING?
1548         ADDI    A,PDLBUF        ;NO, POINT TO REAL DOPE WORD
1549         MOVMS   B
1550         CAIN    A,2(C)
1551         JRST    NOPF
1552         SETOM   1(C)            ; START FENECE POST
1553         CAIN    A,3(C)
1554         JRST    NOPF
1555         MOVSI   D,1(C)
1556         HRRI    D,2(C)
1557         BLT     D,-2(A)
1558
1559 NOPF:   CAMG    B,PMAX          ;TOO BIG?
1560         CAMG    B,PMIN          ;OR TOO LITTLE
1561         JRST    .+2             ;YES, MUNG IT
1562         POPJ    P,
1563         SUB     B,PGOOD
1564         JRST    MUNG3
1565
1566
1567 ; ROUTINE TO PRE MARK SPECIAL HACKS
1568
1569 PRMRK:  SKIPE   GCHAIR          ; FLUSH IF NO HAIR
1570         POPJ    P,
1571 PRMRK2: HLRE    B,A
1572         SUBI    A,(B)           ;POINT TO DOPE WORD
1573         HLRZ    F,1(A)          ; GET LNTH
1574         LDB     0,[111100,,(A)] ; GET GROWTHS
1575         TRZE    0,400           ; SIGN HACK
1576         MOVNS   0
1577         ASH     0,6             ; TO WORDS
1578         ADD     F,0
1579         LDB     0,[001100,,(A)]
1580         TRZE    0,400
1581         MOVNS   0
1582         ASH     0,6
1583         ADD     F,0
1584         PUSHJ   P,ALLOGC
1585         HRRM    0,1(A)          ; NEW RELOCATION FIELD
1586         IORM    D,1(A)          ;AND MARK
1587         POPJ    P,
1588
1589
1590 \f;GENERAL MARK SUBROUTINE.  CALLED TO MARK ALL THINGS
1591 ; A/ GOODIE TO MARK FROM
1592 ; B/ TYPE OF A (IN RH)
1593 ; C/ TYPE,DATUM PAIR POINTER
1594
1595 MARK2A:
1596 MARK2:  HLRZ    B,(C)           ;GET TYPE
1597 MARK1:  MOVE    A,1(C)          ;GET GOODIE
1598 MARK:   SKIPN   DUMFLG
1599         JUMPE   A,CPOPJ         ; NEVER MARK 0
1600         MOVEI   0,1(A)
1601         CAIL    0,@PURBOT
1602         JRST    GCRETD
1603 MARCON: PUSH    P,A
1604         HRLM    C,-1(P)         ;AND POINTER TO IT
1605         ANDI    B,TYPMSK        ; FLUSH MONITORS
1606         SKIPE   DUMFLG          ; SKIP IF NOT IN DUMPER
1607         PUSHJ   P,TYPHK         ; HACK SOME TYPES
1608         LSH     B,1             ;TIMES 2 TO GET SAT
1609         HRRZ    B,@TYPNT        ;GET SAT
1610         ANDI    B,SATMSK
1611         JUMPE   A,GCRET
1612         CAILE   B,NUMSAT        ; SKIP IF TEMPLATE DATA
1613         JRST    TD.MRK
1614         SKIPN   GCDFLG
1615 IFN ITS,[
1616         JRST    @MKTBS(B)       ;AND GO MARK
1617         JRST    @GCDISP(B)      ; DISPATCH FOR DUMPERS
1618 ]
1619 IFE ITS,[
1620         SKIPA   E,MKTBS(B)
1621         MOVE    E,GCDISP(B)
1622         HRLI    E,-1
1623         JRST    (E)
1624 ]
1625 ; HERE TO MARK A POSSIBLE DEFER POINTER
1626
1627 DEFQMK: GETYP   B,(A)           ; GET ITS TYPE
1628         LSH     B,1
1629         HRRZ    B,@TYPNT
1630         ANDI    B,SATMSK        ; AND TO SAT
1631         SKIPGE  MKTBS(B)
1632
1633 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
1634
1635 DEFMK:  TLOA    TYPNT,400000    ;USE SIGN BIT AS FLAG
1636
1637 ;HERE TO MARK LIST ELEMENTS
1638
1639 PAIRMK: TLZ     TYPNT,400000    ;TURN OF DEFER BIT
1640         PUSH    P,[0]           ; WILL HOLD BACK PNTR
1641         MOVEI   C,(A)           ; POINT TO LIST
1642 PAIRM1: CAMGE   C,PARTOP        ;CHECK FOR BEING IN BOUNDS
1643         CAMGE   C,PARBOT
1644         FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE
1645         SKIPGE  B,(C)           ;SKIP IF NOT MARKED
1646         JRST    RETNEW          ;ALREADY MARKED, RETURN
1647         IORM    D,(C)           ;MARK IT
1648         SKIPL   FPTR            ; SEE IF IN FRONTEIR
1649         PUSHJ   P,MOVFNT        ; EXPAND THE FRONTEIR
1650         MOVEM   B,FRONT(FPTR)
1651         MOVE    0,1(C)          ; AND 2D
1652         AOBJN   FPTR,.+2        ; AOS AND CHECK FRONTEIR
1653         PUSHJ   P,MOVFNT        ; EXPAND FRONTEIR
1654         MOVEM   0,FRONT(FPTR)
1655         ADD     FPTR,[1,,1]     ; MOVE ALONG IN FRONTIER
1656
1657
1658 PAIRM2: MOVEI   A,@BOTNEW       ; GET INF ADDR
1659         SUBI    A,2
1660         HRRM    A,(C)           ; LEAVE A POINTER TO NEW HOME
1661         HRRZ    E,(P)           ; GET BACK POINTER
1662         JUMPE   E,PAIRM7        ; 1ST ONE, NEW FIXUP
1663         MOVSI   0,(HRRM)        ; INS FOR CLOBBER
1664         PUSHJ   P,SMINF         ; SMASH INF'S CORE IMAGE
1665 PAIRM4: MOVEM   A,(P)           ; NEW BACK POINTER
1666         JUMPL   TYPNT,DEFDO     ;GO HANDLE DEFERRED POINTER
1667         HRLM    B,(P)           ; SAVE OLD CDR
1668         PUSHJ   P,MARK2         ;MARK THIS DATUM
1669         HRRZ    E,(P)           ; SMASH CAR IN CASE CHANGED
1670         ADDI    E,1
1671         MOVSI   0,(MOVEM)
1672         PUSHJ   P,SMINF
1673         HLRZ    C,(P)           ;GET CDR OF LIST
1674         CAIGE   C,@PURBOT       ; SKIP IF PURE (I.E. DONT MARK)
1675         JUMPN   C,PAIRM1        ;IF NOT NIL, MARK IT
1676 GCRETP: SUB     P,[1,,1]
1677
1678 GCRET:  TLZ     TYPNT,400000    ;FOR PAIRMKS BENEFIT
1679         HLRZ    C,-1(P)         ;RESTORE C
1680         POP     P,A
1681         POPJ    P,              ;AND RETURN TO CALLER
1682
1683 GCRETD: ANDI    B,TYPMSK        ; TURN OFF MONITORS
1684         CAIN    B,TLOCR         ; SEE IF A LOCR
1685         JRST    MARCON
1686         SKIPN   GCDFLG          ; SKIP IF IN PURIFIER OR DUMPER
1687         POPJ    P,
1688         CAIE    B,TATOM         ; WE MARK PURE ATOMS
1689          CAIN   B,TCHSTR        ; AND STRINGS
1690           JRST  MARCON
1691         POPJ    P,
1692
1693 ;HERE TO MARK DEFERRED POINTER
1694
1695 DEFDO:  PUSH    P,B             ; PUSH OLD PAIR ON STACK
1696         PUSH    P,1(C)
1697         MOVEI   C,-1(P)         ; USE AS NEW DATUM
1698         PUSHJ   P,MARK2         ;MARK THE DATUM
1699         HRRZ    E,-2(P)         ; GET POINTER IN INF CORE
1700         ADDI    E,1
1701         MOVSI   0,(MOVEM)
1702         PUSHJ   P,SMINF         ; AND CLOBBER
1703         HRRZ    E,-2(P)
1704         MOVE    A,-1(P)
1705         MOVSI   0,(HRRM)                ; SMASH IN RIGHT HALF
1706         PUSHJ   P,SMINF
1707         SUB     P,[3,,3]
1708         JRST    GCRET           ;AND RETURN
1709
1710
1711 PAIRM7: MOVEM   A,-1(P)         ; SAVE NEW VAL FOR RETURN
1712         JRST    PAIRM4
1713
1714 RETNEW: HRRZ    A,(C)           ; POINT TO NEW WORLD LOCN
1715         HRRZ    E,(P)           ; BACK POINTER
1716         JUMPE   E,RETNW1        ; NONE
1717         MOVSI   0,(HRRM)
1718         PUSHJ   P,SMINF
1719         JRST    GCRETP
1720
1721 RETNW1: MOVEM   A,-1(P)
1722         JRST    GCRETP
1723
1724 ; ROUTINE TO EXPAND THE FRONTEIR
1725
1726 MOVFNT: PUSH    P,B             ; SAVE REG B
1727         HRRZ    A,BOTNEW        ; CURRENT BOTTOM OF WINDOW
1728         ADDI    A,2000          ; MOVE IT UP
1729         HRRM    A,BOTNEW
1730         HRRZM   A,FNTBOT                ; BOTTOM OF FRONTEIR
1731         MOVEI   B,FRNP
1732         ASH     A,-10.          ; TO PAGES
1733         PUSHJ   P,%GETIP
1734         PUSHJ   P,%SHWND        ; SHARE THE PAGE
1735         MOVSI   FPTR,-2000      ; FIX UP FPTR
1736         POP     P,B
1737         POPJ    P,
1738
1739
1740 ; ROUTINE TO SMASH INFERIORS PPAGES
1741 ; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE
1742
1743 SMINF:  CAMGE   E,FNTBOT
1744         JRST    SMINF1          ; NOT IN FRONTEIR
1745         SUB     E,FNTBOT        ; ADJUST POINTER
1746         IOR     0,[0 A,FRONT(E)]        ; BUILD INSTRUCTION
1747         XCT     0               ; XCT IT
1748         POPJ    P,              ; EXIT
1749 SMINF1: CAML    E,WNDBOT
1750         CAML    E,WNDTOP        ; SEE IF IN WINDOW
1751         JRST    SMINF2
1752 SMINF3: SUB     E,WNDBOT        ; FIX UP
1753         IOR     0,[0 A,WIND(E)] ; FIX INS
1754         XCT     0
1755         POPJ    P,
1756 SMINF2: PUSH    P,A             ; SAVE E
1757         PUSH    P,B             ; SAVE B
1758         HRRZ    A,E             ; E SOMETIMES HAS STUFF IN LH
1759         ASH     A,-10.
1760         MOVEI   B,WNDP          ; WINDOW PAGE
1761         PUSHJ   P,%SHWND        ; SHARE IT
1762         ASH     A,10.           ; TO PAGES
1763         MOVEM   A,WNDBOT                ; UPDATE POINTERS
1764         ADDI    A,2000
1765         MOVEM   A,WNDTOP
1766         POP     P,B             ; RESTORE ACS
1767         POP     P,A
1768         JRST    SMINF3          ; FIX UP INF
1769
1770
1771
1772 \f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
1773
1774 TPMK:   TLOA    TYPNT,400000    ;SET TP MARK FLAG
1775 VECTMK: TLZ     TYPNT,400000
1776         MOVEI   0,@BOTNEW       ; POINTER TO INF
1777         PUSH    P,0
1778         MOVEI   E,(A)           ;SAVE A POINTER TO THE VECTOR
1779         HLRE    B,A             ;GET -LNTH
1780         SUB     A,B             ;LOCATE DOPE WORD
1781         MOVEI   A,1(A)          ;ZERO LH AND POINT TO 2ND DOPE WORD
1782         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1783         CAMLE   A,GCSTOP
1784         JRST    VECTB1          ;LOSE, COMPLAIN
1785
1786         HLLM    TYPNT,(P)       ; SAVE MARKER INDICATING STACK
1787         JUMPGE  TYPNT,NOBUFR    ;IF A VECTOR, NO BUFFER CHECK
1788         CAME    A,PGROW         ;IS THIS THE BLOWN P
1789         CAMN    A,TPGROW        ;IS THIS THE GROWING PDL
1790         JRST    NOBUFR          ;YES, DONT ADD BUFFER
1791         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
1792         MOVSI   0,-PDLBUF       ;ALSO FIX UP POINTER
1793         ADD     0,1(C)
1794         MOVEM   0,-1(P)         ; FIXUP RET'D PNTR
1795
1796 NOBUFR: HLRE    B,(A)           ;GET LENGTH FROM DOPE WORD
1797         JUMPL   B,EXVECT        ; MARKED, LEAVE
1798         LDB     B,[111100,,-1(A)]       ; GET TOP GROWTH
1799         TRZE    B,400           ; HACK SIGN BIT
1800         MOVNS   B
1801         ASH     B,6             ; CONVERT TO WORDS
1802         PUSH    P,B             ; SAVE TOP GROWTH
1803         LDB     0,[001100,,-1(A)]       ;GET GROWTH FACTOR
1804         TRZE    0,400           ;KILL SIGN BIT AND SKIP IF +
1805         MOVNS   0               ;NEGATE
1806         ASH     0,6             ;CONVERT TO NUMBER OF WORDS
1807         PUSH    P,0             ; SAVE BOTTOM GROWTH
1808         ADD     B,0             ;TOTAL GROWTH TO B
1809 VECOK:  HLRE    E,(A)           ;GET LENGTH AND MARKING
1810         MOVEI   F,(E)           ;SAVE A COPY
1811         ADD     F,B             ;ADD GROWTH
1812         SUBI    E,2             ;- DOPE WORD LENGTH
1813         IORM    D,(A)           ;MAKE SURE NOW MARKED
1814         PUSHJ   P,ALLOGC        ; ALLOCATE SPACE FOR VECTOR IN THE INF
1815         HRRM    0,(A)
1816 VECOK1: JUMPLE  E,MOVEC2        ; ZERO LENGTH, LEAVE
1817         PUSH    P,A             ; SAVE POINTER TO DOPE WORD
1818         SKIPGE  B,-1(A)         ;SKIP IF UNIFORM
1819         TLNE    B,377777-.VECT. ;SKIP IF NOT SPECIAL
1820         JUMPGE  TYPNT,NOTGEN    ;JUMP IF NOT A GENERAL VECTOR
1821
1822 GENRAL: HLRZ    0,B             ;CHECK FOR PSTACK
1823         TRZ     0,.VECT.
1824         JUMPE   0,NOTGEN        ;IT ISN'T GENERAL
1825         JUMPL   TYPNT,TPMK1     ; JUMP IF TP
1826         MOVEI   C,(A)
1827         SUBI    C,1(E)          ; C POINTS TO BEGINNING OF VECTOR
1828
1829 \f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR
1830 VECTM2: HLRE    B,(C)           ;GET TYPE AND MARKING
1831         JUMPL   B,UMOVEC                ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1832         MOVE    A,1(C)          ;DATUM TO A
1833
1834
1835 VECTM3: PUSHJ   P,MARK          ;MARK DATUM
1836         MOVEM   A,1(C)          ; IN CASE WAS FIXED
1837 VECTM4: ADDI    C,2
1838         JRST    VECTM2
1839
1840 UMOVEC: POP     P,A
1841 MOVEC2: POP     P,C             ; RESTORE BOTTOM GROWTH
1842         HRRZ    E,-1(P)         ; GET POINTER INTO INF
1843         SKIPN   C               ; SKIP IF NO BOTTOM GROWTH
1844         JRST    MOVEC3
1845         JUMPL   C,.+3           ; SEE IF BOTTOM SHRINKAGE
1846         ADD     E,C             ; GROW IT
1847         JRST    MOVEC3          ; CONTINUE
1848         HRLM    C,E             ; MOVE SHRINKAGE FOR TRANSFER PHASE
1849 MOVEC3: PUSHJ   P,DOPMOD        ; MODIFY DOPE WORD AND PLACE IN INF
1850         PUSHJ   P,TRBLKV                ; SEND VECTOR INTO INF
1851 TGROT:  CAMGE   A,PARBOT                ; SKIP IF NOT STORAGE
1852         JRST    TGROT1
1853         MOVE    C,DOPSV1        ; RESTORE DOPE WORD
1854         SKIPN   (P)             ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH
1855         MOVEM   C,-1(A)
1856 TGROT1: POP     P,C             ; IS THERE TOP GROWH
1857         SKIPN   C               ; SEE IF ANY GROWTH
1858         JRST    DOPEAD
1859         SUBI    E,2
1860         SKIPG   C
1861         JRST    OUTDOP
1862         PUSH    P,C             ; SAVE C
1863         SETZ    C,              ; ZERO C
1864         PUSHJ   P,ADWD
1865         ADDI    E,1
1866         SETZ    C,              ; ZERO WHERE OLD DOPE WORDS WERE
1867         PUSHJ   P,ADWD
1868         POP     P,C
1869         ADDI    E,-1(C)         ; MAKE ADJUSTMENT FOR TOP GROWTH
1870 OUTDOP: PUSHJ   P,DOPOUT
1871 DOPEAD:
1872 EXVECT: HLRZ    B,(P)
1873         SUB     P,[1,,1]        ; GET RID OF FPTR
1874         PUSHJ   P,RELATE        ; RELATIVIZE
1875         TRNN    B,400000        ; WAS THIS A STACK
1876         JRST    GCRET
1877         MOVSI   0,PDLBUF        ; FIX UP STACK PTR
1878         ADDM    0,(P)
1879         JRST    GCRET           ; EXIT
1880
1881 VECLOS: JUMPL   C,CCRET         ;JUMP IF CAN'T MUNG TYPE
1882         HLLZ    0,(C)           ;GET TYPE
1883         MOVEI   B,TILLEG        ;GET ILLEGAL TYPE
1884         HRLM    B,(C)
1885         MOVEM   0,1(C)          ;AND STORE OLD TYPE AS VALUE
1886         JRST    UMOVEC          ;RETURN WITHOUT MARKING VECTOR
1887
1888 CCRET:  CLEARM  1(C)            ;CLOBBER THE DATUM
1889         JRST    GCRET
1890
1891 \f
1892 ; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN
1893 ; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL.
1894
1895 TPMK1:
1896 TPMK2:  POP     P,A
1897         POP     P,C
1898         HRRZ    E,-1(P)         ; FIX UP PARAMS
1899         ADDI    E,(C)
1900         PUSH    P,A             ; REPUSH A
1901         HRRZ    B,(A)           ; CALCULATE RELOCATION
1902         SUB     B,A
1903         MOVE    C,-1(P)         ; ADJUST FOR GROWTH
1904         SUB     B,C
1905         HRLZS   C
1906         PUSH    P,C
1907         PUSH    P,B
1908         PUSH    P,E
1909         PUSH    P,[0]
1910 TPMK3:  HLRZ    E,(A)           ; GET LENGTH
1911         TRZ     E,400000        ; GET RID OF MARK BIT
1912         SUBI    A,-1(E)         ;POINT TO FIRST ELEMENT
1913         MOVEI   C,(A)           ;POINT TO FIRST ELEMENT WITH C
1914 TPMK4:  HLRE    B,(C)           ;GET TYPE AND MARKING
1915         JUMPL   B,TPMK7         ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1916         HRRZ    A,(C)           ;DATUM TO A
1917         ANDI    B,TYPMSK        ; FLUSH MONITORS
1918         CAIE    B,TCBLK
1919         CAIN    B,TENTRY        ;IS THIS A STACK FRAME
1920         JRST    MFRAME          ;YES, MARK IT
1921         CAIE    B,TUBIND                ; BIND
1922         CAIN    B,TBIND         ;OR A BINDING BLOCK
1923         JRST    MBIND
1924         CAIE    B,TBVL          ; CHECK FOR OTHER BINDING HACKS
1925         CAIN    B,TUNWIN
1926         SKIPA                   ; FIX UP SP-CHAIN
1927         CAIN    B,TSKIP         ; OTHER BINDING HACK
1928         PUSHJ   P,FIXBND
1929
1930
1931 TPMK5:  PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
1932         HRRM    A,(C)           ; FIX UP IN CASE OF SP CHAIN
1933         PUSHJ   P,MARK1         ;MARK DATUM
1934         MOVE    R,A             ; SAVE A
1935         POP     P,M
1936         MOVE    A,(C)
1937         PUSHJ   P,OUTTP         ; MOVE OUT TYPE
1938         MOVE    A,R
1939         PUSHJ   P,OUTTP         ; SEND OUT VALUE
1940         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
1941 TPMK6:  ADDI    C,2
1942         JRST    TPMK4
1943
1944 MFRAME: HRRZ    0,1(C)          ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME
1945         HRROI   C,FRAMLN+FSAV-1(C)      ;POINT TO FUNCTION
1946         HRRZ    A,1(C)          ; GET IT
1947         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
1948         CAMLE   A,GCSTOP
1949         JRST    MFRAM1          ; IGNORE, NOT IN VECTOR SPACE
1950         HRL     A,(A)           ; GET LENGTH
1951         MOVEI   B,TVEC
1952         PUSHJ   P,MARK          ; AND MARK IT
1953 MFRAM1: HLL     A,1(C)
1954         PUSHJ   P,OUTTP         ; SEND IT OUT
1955         HRRZ    A,OTBSAV-FSAV+1(C)      ; POINT TO TB TO PREVIOUS FRAME
1956         SKIPE   A
1957         ADD     A,-2(P)         ; RELOCATE IF NOT 0
1958         HLL     A,2(C)
1959         PUSHJ   P,OUTTP         ; SEND IT OUT
1960         MOVE    A,-2(P)         ; ADJUST AB SLOT
1961         ADD     A,ABSAV-FSAV+1(C)       ; POINT TO SAVED AB
1962         PUSHJ   P,OUTTP         ; SEND IT OUT
1963         MOVE    A,-2(P)         ; ADJUST SP SLOT
1964         ADD     A,SPSAV-FSAV+1(C)       ;POINT TO SAVED SP
1965         SUB     A,-3(P)         ; ADJUSTMENT OF LENGTH IF GROWTH
1966         PUSHJ   P,OUTTP         ; SEND IT OUT
1967         HRROI   C,PSAV-FSAV(C)  ;POINT TO SAVED P
1968         MOVEI   B,TPDL
1969         PUSHJ   P,MARK1         ;AND MARK IT
1970         PUSHJ   P,OUTTP         ; SEND IT OUT
1971         HLRE    0,TPSAV-PSAV+1(C)
1972         MOVE    A,TPSAV-PSAV+1(C)
1973         SUB     A,0
1974         MOVEI   0,1(A)
1975         MOVE    A,TPSAV-PSAV+1(C)
1976         CAME    0,TPGROW        ; SEE IF BLOWN
1977         JRST    MFRAM9
1978         MOVSI   0,PDLBUF
1979         ADD     A,0
1980 MFRAM9: ADD     A,-2(P)
1981         SUB     A,-3(P)         ; ADJUST
1982         PUSHJ   P,OUTTP
1983         MOVE    A,PCSAV-PSAV+1(C)
1984         PUSHJ   P,OUTTP
1985         HRROI   C,-PSAV+1(C)    ; POINT PAST THE FRAME
1986         JRST    TPMK4           ;AND DO MORE MARKING
1987
1988
1989 MBIND:  PUSHJ   P,FIXBND
1990         MOVEI   B,TATOM         ;FIRST MARK ATOM
1991         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL NOW
1992         SKIPE   (P)             ; PASSED MARKER, IF SO DONT SKIP
1993         JRST    MBIND2          ; GO MARK
1994         MOVE    A,1(C)          ; RESTORE A
1995         CAME    A,GCATM
1996         JRST    MBIND1          ; NOT IT, CONTINUE SKIPPING
1997         HRRM    LPVP,2(C)       ; SAVE IN RH OF TPVP,,0
1998         MOVE    0,-4(P)         ; RECOVER PTR TO DOPE WORD
1999         HRLM    0,2(C)          ; SAVE FOR MOVEMENT
2000         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
2001         PUSHJ   P,MARK1         ; MARK THE ATOM
2002         MOVEI   LPVP,(C)        ; POINT
2003         SETOM   (P)             ; INDICATE PASSAGE
2004 MBIND1: ADDI    C,6             ; SKIP BINDING
2005         MOVEI   0,6
2006         SKIPE   -1(P)           ; ONLY UPDATE IF SENDING OVER
2007         ADDM    0,-1(P)
2008         JRST    TPMK4
2009
2010 MBIND2: HLL     A,(C)
2011         PUSHJ   P,OUTTP         ; FIX UP CHAIN
2012         MOVEI   B,TATOM         ; RESTORE IN CASE SMASHED
2013         PUSHJ   P,MARK1         ; MARK ATOM
2014         PUSHJ   P,OUTTP         ; SEND IT OUT
2015         ADDI    C,2
2016         PUSH    P,(C)           ; SAVE BECAUSE FRAMES MIGHT MUNG IT
2017         PUSHJ   P,MARK2         ;MARK DATUM
2018         MOVE    R,A             ; SAVE A
2019         POP     P,M
2020         MOVE    A,(C)
2021         PUSHJ   P,OUTTP         ; MOVE OUT TYPE
2022         MOVE    A,R
2023         PUSHJ   P,OUTTP         ; SEND OUT VALUE
2024         MOVEM   M,(C)           ; RESTORE TO OLD VALUE
2025         ADDI    C,2
2026         MOVEI   B,TLIST         ; POINT TO DECL SPECS
2027         HLRZ    A,(C)
2028         PUSHJ   P,MARK          ; AND MARK IT
2029         HRR     A,(C)           ; LIST FIX UP
2030         PUSHJ   P,OUTTP
2031         SKIPL   A,1(C)          ; PREV LOC?
2032         JRST    NOTLCI
2033         MOVEI   B,TLOCI         ; NOW MARK LOCATIVE
2034         PUSHJ   P,MARK1
2035 NOTLCI: PUSHJ   P,OUTTP
2036         ADDI    C,2
2037         JRST    TPMK4
2038
2039 FIXBND: HRRZ    A,(C)           ; GET PTR TO CHAIN
2040         SKIPE   A               ; DO NOTHING IF EMPTY
2041         ADD     A,-3(P)
2042         POPJ    P,
2043 TPMK7:
2044 TPMK8:  MOVNI   A,1             ; FENCE-POST THE STACK
2045         PUSHJ   P,OUTTP
2046         ADDI    C,1             ; INCREMENT C FOR FENCE-POST
2047         SUB     P,[1,,1]        ; CLEAN UP STACK
2048         POP     P,E             ; GET UPDATED PTR TO INF
2049         SUB     P,[2,,2]        ; POP OFF RELOCATION
2050         HRRZ    A,(P)
2051         HLRZ    B,(A)
2052         TRZ     B,400000
2053         SUBI    A,-1(B)
2054         SUBI    C,(A)           ; GET # OF WORDS TRANSFERED
2055         SUB     B,C             ; GET # LEFT
2056         ADDI    E,-2(B)         ; ADJUST POINTER TO INF
2057         POP     P,A
2058         POP     P,C             ; IS THERE TOP GROWH
2059         ADD     E,C             ; MAKE ADJUSTMENT FOR TOP GROWTH
2060         ANDI    E,-1
2061         PUSHJ   P,DOPMOD        ; FIX UP DOPE WORDS
2062         PUSHJ   P,DOPOUT        ; SEND THEM OUT
2063         JRST    DOPEAD
2064
2065
2066 \f; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR
2067 ; F= # OF WORDS TO ALLOCATE
2068
2069 ALLOGC: HRRZS   A               ; GET ABS VALUE
2070         SKIPN   GCDFLG          ; SKIP IF IN DUMPER
2071         CAML    A,GCSBOT        ; SKIP IF IN STORAGE
2072         JRST    ALOGC2          ; JUMP IF ALLOCATING
2073         HRRZ    0,A
2074         POPJ    P,
2075 ALOGC2: PUSH    P,A             ; SAVE A
2076 ALOGC1: HLRE    0,FPTR          ; GET ROOM LEFT
2077         ADD     0,F             ; SEE IF ITS ENOUGH
2078         JUMPL   0,ALOCOK
2079         MOVE    F,0             ; MODIFY F
2080         PUSH    P,F
2081         PUSHJ   P,MOVFNT        ; MOVE UP FRONTEIR
2082         POP     P,F
2083         JRST    ALOGC1          ; CONTINUE
2084 ALOCOK: ADD     FPTR,F          ; MODIFY FPTR
2085         HRLZS   F
2086         ADD     FPTR,F
2087         POP     P,A             ; RESTORE A
2088         MOVEI   0,@BOTNEW
2089         SUBI    0,1             ; RELOCATION PTR
2090         POPJ    P,              ; EXIT
2091
2092
2093
2094
2095 ; TRBLK MOVES A VECTOR INTO THE INFERIOR
2096 ; E= STARTING ADDR IN INF  A= DOPE WORD OF VECTOR
2097
2098 TRBLK:  HRRZS   A
2099         SKIPE   GCDFLG
2100         JRST    TRBLK7
2101         CAMGE   A,GCSBOT        ; SEE IF IN GC-SPACE
2102         JRST    FIXDOP
2103 TRBLK7: PUSH    P,A
2104         HLRZ    0,(A)
2105         TRZ     0,400000        ; TURN OFF GC FLAG
2106         HRRZ    F,A
2107         HLRE    A,E             ; GET SHRINKAGE
2108         ADD     0,A             ; MUNG LENGTH
2109         SUB     F,0
2110         ADDI    F,1             ; F POINTS TO START OF VECTOR
2111 TRBLK2: HRRZ    R,E             ; SAVE POINTER TO INFERIOR
2112         ADD     E,0             ; E NOW POINTS TO FINAL ADDRESS+1
2113         MOVE    M,E             ;SAVE E
2114 TRBLK1: MOVE    0,R
2115         SUBI    E,1
2116         CAMGE   R,FNTBOT        ; SEE IF IN FRONTEIR
2117         JRST    TRBL10
2118         SUB     E,FNTBOT        ; ADJUST E
2119         SUB     0,FNTBOT        ; ADJ START
2120         MOVEI   A,FRONT+1777
2121         JRST    TRBLK4
2122 TRBL10: CAML    R,WNDBOT
2123         CAML    R,WNDTOP        ; SEE IF IN WINDOW
2124         JRST    TRBLK5          ; NO
2125         SUB     E,WNDBOT
2126         SUB     0,WNDBOT
2127         MOVEI   A,WIND+1777
2128 TRBLK4: ADDI    0,-1777(A)      ; CALCULATE START IN WINDOW OR FRONTEIR
2129         CAIL    E,2000
2130         JRST    TRNSWD
2131         ADDI    E,-1777(A)              ; SUBTRACT WINDBOT
2132         HRL     0,F             ; SET UP FOR BLT
2133         BLT     0,(E)
2134         POP     P,A
2135
2136 FIXDOP: IORM    D,(A)
2137         MOVE    E,M             ; GET END OF WORD
2138         POPJ    P,
2139 TRNSWD: PUSH    P,B
2140         MOVEI   B,1(A)          ; GET TOP OF WORLD
2141         SUB     B,0
2142         HRL     0,F
2143         BLT     0,(A)
2144         ADD     F,B             ; ADJUST F
2145         ADD     R,B
2146         POP     P,B
2147         MOVE    E,M             ; RESTORE E
2148         JRST    TRBLK1          ; CONTINUE
2149 TRBLK5: HRRZ    A,R             ; COPY E
2150         ASH     A,-10.          ; TO PAGES
2151         PUSH    P,B             ; SAVE B
2152         MOVEI   B,WNDP          ; IT IS WINDOW
2153         PUSHJ   P,%SHWND
2154         ASH     A,10.           ; TO PAGES
2155         MOVEM   A,WNDBOT                ; UPDATE POINTERS
2156         ADDI    A,2000
2157         MOVEM   A,WNDTOP
2158         POP     P,B             ; RESTORE B
2159         JRST    TRBL10
2160
2161
2162
2163
2164 ; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE
2165
2166 TRBLKV: HRRZS   A
2167         SKIPE   GCDFLG          ; SKIP IF NOT IN DUMPER
2168         JRST    TRBLV2
2169         CAMGE   A,GCSBOT        ; SEE IF IN GC-SPACE
2170         JRST    FIXDOP
2171 TRBLV2: PUSH    P,A             ; SAVE A
2172         HLRZ    0,DOPSV2
2173         TRZ     0,400000
2174         HRRZ    F,A
2175         HLRE    A,E             ; GET SHRINKAGE
2176         ADD     0,A             ; MUNG LENGTH
2177         SUB     F,0
2178         ADDI    F,1             ; F POINTS TO START OF VECTOR
2179         SKIPGE  -2(P)           ; SEE IF SHRINKAGE
2180         ADD     0,-2(P)         ; IF SO COMPENSATE
2181         JRST    TRBLK2          ; CONTINUE
2182
2183 ; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN   0= # OF WORDS
2184
2185 TRBLK3: PUSH    P,A             ; SAVE A
2186         MOVE    F,A
2187         JRST    TRBLK2
2188
2189 ; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT
2190 ; F==> START OF TRANSFER IN GCS 0= # OF WORDS
2191
2192 TRBLKX: PUSH    P,A             ; SAVE A
2193         JRST    TRBLK2          ; SEND IT OUT
2194
2195
2196 ; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN
2197 ; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED
2198 ; A CONTAINS THE WORD TO BE SENT OUT
2199
2200 OUTTP:  AOS     E,-2(P)         ; INCREMENT PLACE
2201         MOVSI   0,(MOVEM)               ; INS FOR SMINF
2202         SOJA    E,SMINF
2203
2204
2205 ; ADWD PLACES ONE WORD IN THE INF
2206 ; E ==> INF  C IS THE WORD
2207
2208 ADWD:   PUSH    P,E             ; SAVE AC'S
2209         PUSH    P,A
2210         MOVE    A,C             ; GET WORD
2211         MOVSI   0,(MOVEM)       ; INS FOR SMINF
2212         PUSHJ   P,SMINF         ; SMASH IT IN
2213         POP     P,A
2214         POP     P,E
2215         POPJ    P,              ; EXIT
2216
2217 ; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE
2218 ; SUCH AS THE TP AND GROWTH
2219
2220
2221 DOPOUT: MOVE    C,-1(A)
2222         PUSHJ   P,ADWD
2223         ADDI    E,1
2224         MOVE    C,(A)           ; GET SECOND DOPE WORD
2225         TLZ     C,400000        ; TURN OFF POSSIBLE MARK BIT
2226         PUSHJ   P,ADWD
2227         MOVE    C,DOPSV1        ; FIX UP FIRST DOPE WORD
2228         MOVEM   C,-1(A)
2229         MOVE    C,DOPSV2
2230         MOVEM   C,(A)           ; RESTORE SECOND D.W.
2231         POPJ    P,
2232
2233 ; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF
2234 ; A ==> DOPE WORD  E==> INF
2235
2236 DOPMOD: SKIPE   GCDFLG          ; CHECK TO SEE IF IN DUMPER AND PURIFY
2237         JRST    .+3
2238         CAMG    A,GCSBOT
2239         POPJ    P,              ; EXIT IF NOT IN GCS
2240         MOVE    C,-1(A)         ; GET FIRST DOPE WORD
2241         MOVEM   C,DOPSV1
2242         HLLZS   C               ; CLEAR OUT GROWTH
2243         TLO     C,.VECT.        ; FIX UP FOR GCHACK
2244         PUSH    P,C
2245         MOVE    C,(A)           ; GET SECOND DOPE WORD
2246         HLRZ    B,(A)           ; GET LENGTH
2247         TRZ     B,400000        ; TURN OFF MARK BIT
2248         MOVEM   C,DOPSV2
2249         HRRZ    0,-1(A)         ; CHECK FOR GROWTH
2250         JUMPE   0,DOPMD1
2251         LDB     0,[111100,,-1(A)]       ; MODIFY WITH GROWTH
2252         TRZE    0,400
2253         MOVNS   0
2254         ASH     0,6
2255         ADD     B,0
2256         LDB     0,[001100,,-1(A)]
2257         TRZE    0,400
2258         MOVNS   0
2259         ASH     0,6
2260         ADD     B,0
2261 DOPMD1: HRL     C,B             ; FIX IT UP
2262         MOVEM   C,(A)           ; FIX IT UP
2263         POP     P,-1(A)
2264         POPJ    P,
2265
2266 ADPMOD: CAMG    A,GCSBOT
2267         POPJ    P,              ; EXIT IF NOT IN GCS
2268         MOVE    C,-1(A)         ; GET FIRST DOPE WORD
2269         TLO     C,.VECT.        ; FIX UP FOR GCHACK
2270         MOVEM   C,-1(A)
2271         MOVE    C,(A)           ; GET SECOND DOPE WORD
2272         TLZ     C,400000                ; TURN OFF PARK BIT
2273         MOVEM   C,(A)
2274         POPJ    P,
2275
2276
2277
2278
2279 \f; RELATE RELATAVIZES A POINTER TO A VECTOR
2280 ; B IS THE POINTER  A==> DOPE WORD
2281
2282 RELATE: SKIPE   GCDFLG          ; SEE IF DUMPER OR PURIFIER
2283         JRST    .+3
2284         CAMGE   A,GCSBOT        ; SEE IF IN VECTOR SPACE
2285         POPJ    P,              ; IF NOT EXIT
2286         MOVE    C,-1(P)
2287         HLRE    F,C             ; GET LENGTH
2288         HRRZ    0,-1(A)         ; CHECK FO GROWTH
2289         JUMPE   A,RELAT1
2290         LDB     0,[111100,,-1(A)]       ; GET TOP GROWTH
2291         TRZE    0,400           ; HACK SIGN BIT
2292         MOVNS   0
2293         ASH     0,6             ; CONVERT TO WORDS
2294         SUB     F,0             ; ACCOUNT FOR GROWTH
2295 RELAT1: HRLM    F,C             ; PLACE CORRECTED LENGTH BACK IN POINTER
2296         HRRZ    F,(A)           ; GET RELOCATED ADDR
2297         SUBI    F,(A)           ; FIND RELATIVIZATION AMOUNT
2298         ADD     C,F             ; ADJUST POINTER
2299         SUB     C,0             ; ACCOUNT FOR GROWTH
2300         MOVEM   C,-1(P)
2301         POPJ    P,
2302
2303
2304
2305 \f; MARK TB POINTERS
2306 TBMK:   HRRZS   A               ; CHECK FOR NIL POINTER
2307         SKIPN   A
2308         JRST    GCRET           ; IF POINTING TO NIL THEN RETURN
2309         HLRE    B,TPSAV(A)      ; MAKE POINTER LOOK LIKE A TP POINTER
2310         HRRZ    C,TPSAV(A)              ; GET TO DOPE WORD
2311 TBMK2:  SUB     C,B             ; POINT TO FIRST DOPE WORD
2312         HRRZ    A,(P)           ; GET PTR TO FRAME
2313         SUB     A,C             ; GET PTR TO FRAME
2314         HRLS    A
2315         HRR     A,(P)
2316         PUSH    P,A
2317         MOVEI   C,-1(P)
2318         MOVEI   B,TTP
2319         PUSHJ   P,MARK
2320         SUB     P,[1,,1]
2321         HRRM    A,(P)
2322         JRST    GCRET
2323 ABMK:   HLRE    B,A             ; FIX UP TO GET TO FRAME
2324         SUB     A,B
2325         HLRE    B,FRAMLN+TPSAV(A)       ; FIX UP TO LOOK LIKE TP
2326         HRRZ    C,FRAMLN+TPSAV(A)
2327         JRST    TBMK2
2328
2329
2330 \f
2331 ; MARK ARG POINTERS
2332
2333 ARGMK:  HRRZ    A,1(C)          ; GET POINTER
2334         HLRE    B,1(C)          ; AND LNTH
2335         SUB     A,B             ; POINT TO BASE
2336         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
2337         CAMLE   A,GCSTOP
2338         JRST    ARGMK0
2339         HLRZ    0,(A)           ; GET TYPE
2340         ANDI    0,TYPMSK
2341         CAIN    0,TCBLK
2342         JRST    ARGMK1
2343         CAIE    0,TENTRY        ; IS NEXT A WINNER?
2344         CAIN    0,TINFO
2345         JRST    ARGMK1          ; YES, GO ON TO WIN CODE
2346
2347 ARGMK0: SETZB   A,1(C)          ; CLOBBER THE CELL
2348         SETZM   (P)             ; AND SAVED COPY
2349         JRST    GCRET
2350
2351 ARGMK1: MOVE    B,1(A)          ; ASSUME TTB
2352         ADDI    B,(A)           ; POINT TO FRAME
2353         CAIE    0,TINFO         ; IS IT?
2354         MOVEI   B,FRAMLN(A)     ; NO, USE OTHER GOODIE
2355         HLRZ    0,OTBSAV(B)     ; GET TIME
2356         HRRZ    A,(C)           ; AND FROM POINTER
2357         CAIE    0,(A)           ; SKIP IF WINNER
2358         JRST    ARGMK0
2359         MOVE    A,TPSAV(B)              ; GET A RELATAVIZED TP
2360         HRROI   C,TPSAV-1(B)
2361         MOVEI   B,TTP
2362         PUSHJ   P,MARK1
2363         SUB     A,1(C)          ; AMOUNT TO RELATAVIZE ARGS
2364         HRRZ    B,(P)
2365         ADD     B,A
2366         HRRM    B,(P)           ; PUT RELATAVIZED PTR BACK
2367         JRST    GCRET
2368
2369 \f
2370 ; MARK FRAME POINTERS
2371
2372 FRMK:   HLRZ    B,A             ; GET TIME FROM FRAME PTR
2373         HLRZ    F,OTBSAV(A)             ; GET TIME FROM FRAME
2374         CAME    B,F             ; SEE IF EQUAL
2375         JRST    GCRET
2376         SUBI    C,1             ;PREPARE TO MARK PROCESS VECTOR
2377         HRRZ    A,1(C)          ;USE AS DATUM
2378         SUBI    A,1             ;FUDGE FOR VECTMK
2379         MOVEI   B,TPVP          ;IT IS A VECTRO
2380         PUSHJ   P,MARK          ;MARK IT
2381         ADDI    A,1             ; READJUST PTR
2382         HRRM    A,1(C)          ; FIX UP PROCESS SLOT
2383         MOVEI   C,1(C)          ; SET UP FOR TBMK
2384         HRRZ    A,(P)
2385         JRST    TBMK            ; MARK LIKE TB
2386
2387 \f
2388 ; MARK BYTE POINTER
2389
2390 BYTMK:  PUSHJ   P,BYTDOP        ; GET DOPE WORD IN A
2391         HLRZ    F,-1(A)         ; GET THE TYPE
2392         ANDI    F,SATMSK        ; FLUSH MONITOR BITS
2393         CAIN    F,SATOM         ; SEE IF ATOM
2394         JRST    ATMSET
2395         HLRE    F,(A)           ; GET MARKING
2396         JUMPL   F,BYTREL        ; JUMP IF MARKED
2397         HLRZ    F,(A)           ; GET LENGTH
2398         PUSHJ   P,ALLOGC        ; ALLOCATE FOR IT
2399         HRRM    0,(A)           ; SMASH  IT IN
2400         MOVE    E,0
2401         HLRZ    F,(A)
2402         SUBI    E,-1(F)         ; ADJUST INF POINTER
2403         IORM    D,(A)
2404         PUSHJ   P,ADPMOD
2405         PUSHJ   P,TRBLK
2406 BYTREL: HRRZ    E,(A)
2407         SUBI    E,(A)
2408         ADDM    E,(P)           ; RELATAVIZE
2409         JRST    GCRET
2410
2411 ATMSET: PUSH    P,A             ; SAVE A
2412         HLRZ    B,(A)           ; GET LENGTH
2413         TRZ     B,400000        ; GET RID OF MARK BIT
2414         MOVNI   B,-2(B)         ; GET LENGTH
2415         ADDI    A,-1(B)         ; CALCULATE POINTER
2416         HRLI    A,(B)
2417         MOVEI   B,TATOM         ; TYPE
2418         PUSHJ   P,MARK
2419         POP     P,A             ; RESTORE A
2420         SKIPN   GCDFLG
2421          JRST   BYTREL
2422         MOVSI   E,STATM         ; GET "STRING IS ATOM BIT"
2423         IORM    E,(P)
2424         SKIPN   DUMFLG
2425          JRST   GCRET
2426         HRRM    A,(P)
2427         JRST    BYTREL          ; TO BYTREL
2428 \f
2429
2430 ; MARK OFFSET
2431
2432 OFFSMK: HLRZS   A
2433         PUSH    P,$TLIST
2434         PUSH    P,A             ; PUSH LIST POINTER ON THE STACK
2435         MOVEI   C,-1(P)         ; POINTER TO PAIR
2436         PUSHJ   P,MARK2         ; MARK THE LIST
2437         HRLM    A,-2(P)         ; UPDATE POINTER IN OFFSET
2438         SUB     P,[2,,2]
2439         JRST    GCRET
2440 \f
2441
2442 ; MARK ATOMS IN GVAL STACK
2443
2444 GATOMK: HRRZ    B,(C)           ; POINT TO POSSIBLE GDECL
2445         JUMPE   B,ATOMK
2446         CAIN    B,-1
2447         JRST    ATOMK
2448         MOVEI   A,(B)           ; POINT TO DECL FOR MARK
2449         MOVEI   B,TLIST
2450         MOVEI   C,0
2451         PUSHJ   P,MARK
2452         HLRZ    C,-1(P)         ; RESTORE HOME POINTER
2453         HRRM    A,(C)           ; CLOBBER UPDATED LIST IN
2454         MOVE    A,1(C)          ; RESTORE ATOM POINTER
2455
2456 ; MARK ATOMS
2457
2458 ATOMK:
2459         MOVEI   0,@BOTNEW
2460         PUSH    P,0             ; SAVE POINTER TO INF
2461         TLO     TYPNT,.ATOM.    ; SAY ATOM WAS MARKED
2462         MOVEI   C,1(A)
2463         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
2464         JRST    ATMRL1          ; ALREADY MARKED
2465         PUSH    P,A             ; SAVE DOPE WORD PTR FOR LATER
2466         HLRZ    C,(A)           ; FIND REAL ATOM PNTR
2467         SUBI    C,400001        ; KILL MARK BIT AND ADJUST
2468         HRLI    C,-1(C)
2469         SUBM    A,C             ; NOW TOP OF ATOM
2470 MRKOBL: MOVEI   B,TOBLS
2471         HRRZ    A,2(C)          ; IF > 0, NOT OBL
2472         CAMG    A,VECBOT
2473         JRST    .+3
2474         HRLI    A,-1
2475         PUSHJ   P,MARK          ; AND MARK IT
2476         HRRM    A,2(C)
2477         SKIPN   GCHAIR
2478         JRST    NOMKNX
2479         HLRZ    A,2(C)
2480         MOVEI   B,TATOM
2481         PUSHJ   P,MARK
2482         HRLM    A,2(C)
2483 NOMKNX: HLRZ    B,(C)           ; SEE IF UNBOUND
2484         TRZ     B,400000        ; TURN OFF MARK BIT
2485         SKIPE   B
2486         CAIN    B,TUNBOUND
2487         JRST    ATOMK1          ; IT IS UNBOUND
2488         HRRZ    0,(C)           ; SEE IF VECTOR OR TP POINTER
2489         MOVEI   B,TVEC          ; ASSUME VECTOR
2490         SKIPE   0
2491         MOVEI   B,TTP           ; ITS A LOCAL VALUE
2492         PUSHJ   P,MARK1         ; MARK IT
2493         MOVEM   A,1(C)          ; SMASH INTO SLOT
2494 ATOMK1: HRRZ    0,2(C)          ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT
2495         POP     P,A             ; RESTORE A
2496         POP     P,E             ; GET POINTER INTO INF
2497         SKIPN   GCHAIR
2498         JUMPN   0,ATMREL
2499         PUSHJ   P,ADPMOD
2500         PUSHJ   P,TRBLK
2501 ATMREL: HRRZ    E,(A)           ; RELATAVIZE
2502         SUBI    E,(A)
2503         ADDM    E,(P)
2504         JRST    GCRET
2505 ATMRL1: SUB     P,[1,,1]        ; POP OFF STACK
2506         JRST    ATMREL
2507
2508 \f
2509 GETLNT: HLRE    B,A             ;GET -LNTH
2510         SUB     A,B             ;POINT TO 1ST DOPE WORD
2511         MOVEI   A,1(A)          ;POINT TO 2ND DOPE WORD
2512         CAIL    A,STOSTR        ; CHECK IN VECTOR SPACE
2513         CAMLE   A,GCSTOP
2514         JRST    VECTB1          ;BAD VECTOR, COMPLAIN
2515         HLRE    B,(A)           ;GET LENGTH AND MARKING
2516         IORM    D,(A)           ;MAKE SURE MARKED
2517         JUMPL   B,AMTKE
2518         MOVEI   F,(B)           ; AMOUNT TO ALLOCATE
2519         PUSHJ   P,ALLOGC        ;ALLOCATE ROOM
2520         HRRM    0,(A)           ; RELATIVIZE
2521 AMTK1:  AOS     (P)             ; A NON MARKED ITEM
2522 AMTKE:  POPJ    P,              ;AND RETURN
2523
2524 GCRET1: SUB     P,[1,,1]        ;FLUSH RETURN ADDRESS
2525         JRST    GCRET
2526
2527
2528 \f
2529 ; MARK NON-GENERAL VECTORS
2530
2531 NOTGEN: CAMN    B,[GENERAL+<SPVP,,0>]
2532         JRST    GENRAL          ;YES, MARK AS A VECTOR
2533         JUMPL   B,SPECLS        ; COMPLAIN IF A SPECIAL HACK
2534         SUBI    A,1(E)          ;POINT TO TOP OF A UNIFORM VECTOR
2535         HLRZS   B               ;ISOLATE TYPE
2536         ANDI    B,TYPMSK
2537         PUSH    P,E
2538         SKIPE   DUMFLG          ; SKIP IF NOT IN DUMPER
2539         PUSHJ   P,TYPHK         ; HACK WITH TYPE IF SPECIAL
2540         POP     P,E             ; RESTORE LENGTH
2541         MOVE    F,B             ; AND COPY IT
2542         LSH     B,1             ;FIND OUT WHERE IT WILL GO
2543         HRRZ    B,@TYPNT        ;GET SAT IN B
2544         ANDI    B,SATMSK
2545         MOVEI   C,@MKTBS(B)     ;POINT TO MARK SR
2546         CAIN    C,GCRET         ;IF NOT A MARKED FROM GOODIE, IGNORE
2547         JRST    UMOVEC
2548         MOVEI   C,-1(A)         ;POINT 1 PRIOR TO VECTOR START
2549         PUSH    P,E             ;SAVE NUMBER OF ELEMENTS
2550         PUSH    P,F             ;AND UNIFORM TYPE
2551
2552 UNLOOP: MOVE    B,(P)           ;GET TYPE
2553         MOVE    A,1(C)          ;AND GOODIE
2554         TLO     C,400000        ;CAN'T MUNG TYPE
2555         PUSHJ   P,MARK          ;MARK THIS ONE
2556         MOVEM   A,1(C)          ; LIST FIXUP
2557         SOSE    -1(P)           ;COUNT
2558         AOJA    C,UNLOOP        ;IF MORE, DO NEXT
2559
2560         SUB     P,[2,,2]        ;REMOVE STACK CRAP
2561         JRST    UMOVEC
2562
2563
2564 SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR
2565         SUB     P,[4,,4]        ; REOVER
2566         JRST    AFIXUP
2567
2568
2569 \f
2570 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
2571 ; AND UPDATES PTR TO THE TABLE.
2572
2573 GCRDMK: PUSH    P,A             ; SAVE PTR TO TOP
2574         MOVEI   0,@BOTNEW       ; SAVE PTR TO INF
2575         PUSH    P,0
2576         PUSHJ   P,GETLNT        ; GET TO D.W. AND CHECK MARKING
2577         JRST    GCRDRL          ; RELATIVIZE
2578         PUSH    P,A             ; SAVE D.W POINTER
2579         SUBI    A,2
2580         MOVE    B,ABOTN         ; GET TOP OF ATOM TABLE
2581         HRRZ    0,-2(P)
2582         ADD     B,0             ; GET BOTTOM OF ATOM TABLE
2583 GCRD1:  CAMG    A,B             ; DON'T SKIP IF DONE
2584         JRST    GCRD2
2585         HLRZ    C,(A)           ; GET MARKING
2586         TRZN    C,400000        ; SKIP IF MARKED
2587         JRST    GCRD3
2588         MOVEI   E,(A)
2589         SUBI    A,(C)           ; GO BACK ONE ATOM
2590         PUSH    P,B             ; SAVE B
2591         PUSH    P,A             ; SAVE POINTER
2592         MOVEI   C,-2(E)         ; SET UP POINTER
2593         MOVEI   B,TATOM         ; GO TO MARK
2594         MOVE    A,1(C)
2595         PUSHJ   P,MARK
2596         MOVEM   A,1(C)          ; SMASH FIXED UP ATOM BACK IN
2597         POP     P,A
2598         POP     P,B
2599         JRST    GCRD1
2600 GCRD3:  SUBI    A,(C)           ; TO NEXT ATOM
2601         JRST    GCRD1
2602 GCRD2:  POP     P,A             ; GET PTR TO D.W.
2603         POP     P,E             ; GET PTR TO INF
2604         SUB     P,[1,,1]        ; GET RID OF TOP
2605         PUSHJ   P,ADPMOD        ; FIX UP D.W.
2606         PUSHJ   P,TRBLK         ; SEND IT OUT
2607         JRST    ATMREL          ; RELATIVIZE AND LEAVE
2608 GCRDRL: POP     P,A             ; GET PTR TO D.W
2609         SUB     P,[2,,2]        ; GET RID OF TOP AND PTR TO INF
2610         JRST    ATMREL          ; RELATAVIZE
2611
2612
2613 \f
2614 ;MARK RELATAVIZED GLOC HACKS
2615
2616 LOCRMK: SKIPE   GCHAIR
2617         JRST    GCRET
2618 LOCRDP: PUSH    P,C             ; SAVE C
2619         MOVEI   C,-2(A)         ; RELATAVIZED PTR TO ATOM
2620         ADD     C,GLTOP         ; ADD GLOTOP TO GET TO ATOM
2621         MOVEI   B,TATOM         ; ITS AN ATOM
2622         SKIPL   (C)
2623         PUSHJ   P,MARK1
2624         POP     P,C             ; RESTORE C
2625         SKIPN   DUMFLG          ; IF GC-DUMP, WILL STORE ATOM FOR LOCR
2626          JRST   LOCRDD
2627         MOVEI   B,1
2628         IORM    B,3(A)          ; MUNG ATOM TO SAY IT IS LOCR
2629         CAIA
2630 LOCRDD: MOVE    A,1(C)          ; GET RELATIVIZATION
2631         MOVEM   A,(P)           ; IT STAYS THE SAVE
2632         JRST    GCRET
2633
2634 ;MARK LOCID TYPE GOODIES
2635
2636 LOCMK:  HRRZ    B,(C)           ;GET TIME
2637         JUMPE   B,LOCMK1        ; SKIP LEGAL CHECK FOR GLOBAL
2638         HRRZ    0,2(A)          ; GET OTHER TIME
2639         CAIE    0,(B)           ; SAME?
2640         SETZB   A,(P)           ; NO, SMASH LOCATIVE
2641         JUMPE   A,GCRET         ; LEAVE IF DONE
2642 LOCMK1: PUSH    P,C
2643         MOVEI   B,TATOM         ; MARK ATOM
2644         MOVEI   C,-2(A)         ; POINT TO ATOM
2645         MOVE    E,(C)           ; SEE IF BLOCK IS MARKED
2646         TLNE    E,400000                ; SKIP IF MARKED
2647         JRST    LOCMK2          ; SKIP OVER BLOCK
2648         SKIPN   GCHAIR          ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED)
2649         PUSHJ   P,MARK1         ; LET LOCATIVE SAVE THE ATOM
2650 LOCMK2: POP     P,C
2651         HRRZ    E,(C)           ; TIME BACK
2652         MOVEI   B,TVEC          ; ASSUME GLOBAL
2653         SKIPE   E
2654         MOVEI   B,TTP           ; ITS LOCAL
2655         PUSHJ   P,MARK1         ; MARK IT
2656         MOVEM   A,(P)
2657         JRST    GCRET
2658
2659 \f
2660 ; MARK ASSOCIATION BLOCKS
2661
2662 ASMRK:  PUSH    P,A
2663 ASMRK1: HRLI    A,-ASOLNT       ;LOOK LIKE A VECTOR POINTER
2664         PUSHJ   P,GETLNT        ;GET LENGTH AND CHECK BOUNDS
2665         JRST    ASTREL          ; ALREADY MARKED
2666         MOVEI   C,-ASOLNT-1(A)          ;COPY POINTER
2667         PUSHJ   P,MARK2         ;MARK ITEM CELL
2668         MOVEM   A,1(C)
2669         ADDI    C,INDIC-ITEM    ;POINT TO INDICATOR
2670         PUSHJ   P,MARK2
2671         MOVEM   A,1(C)
2672         ADDI    C,VAL-INDIC
2673         PUSHJ   P,MARK2
2674         MOVEM   A,1(C)
2675         SKIPN   GCHAIR          ; IF NO HAIR, MARK ALL FRIENDS
2676         JRST    ASTREL
2677         HRRZ    A,NODPNT-VAL(C) ; NEXT
2678         JUMPN   A,ASMRK1                ; IF EXISTS, GO
2679 ASTREL: POP     P,A             ; RESTORE PTR TO ASSOCIATION
2680         MOVEI   A,ASOLNT+1(A)   ; POINT TO D.W.
2681         SKIPN   NODPNT-ASOLNT-1(A)      ; SEE IF EMPTY NODPTR
2682         JRST    ASTX            ; JUMP TO SEND OUT
2683 ASTR1:  HRRZ    E,(A)           ; RELATAVIZE
2684         SUBI    E,(A)
2685         ADDM    E,(P)
2686         JRST    GCRET           ; EXIT
2687 ASTX:   HRRZ    E,(A)           ; GET PTR IN FRONTEIR
2688         SUBI    E,ASOLNT+1              ; ADJUST TO POINT TO BEGINNING
2689         PUSHJ   P,ADPMOD
2690         PUSHJ   P,TRBLK
2691         JRST    ASTR1
2692
2693 ;HERE WHEN A VECTOR POINTER IS BAD
2694
2695 VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE
2696         SUB     P,[1,,1]        ; RECOVERY
2697 AFIXUP: SETZM   (P)             ; CLOBBER SLOT
2698         JRST    GCRET           ; CONTINUE
2699
2700
2701 VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE
2702         SUB     P,[2,,2]
2703         JRST    AFIXUP          ; RECOVER
2704
2705 PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE
2706         SUB     P,[1,,1]        ; RECOVER
2707         JRST    AFIXUP
2708
2709
2710 \f; HERE TO MARK TEMPLATE DATA STRUCTURES
2711
2712 TD.MRK: MOVEI   0,@BOTNEW       ; SAVE PTR TO INF
2713         PUSH    P,0
2714         HLRZ    B,(A)           ; GET REAL SPEC TYPE
2715         ANDI    B,37777         ; KILL SIGN BIT
2716         MOVEI   E,-NUMSAT-1(B)  ; GET REL POINTER TO TABLE
2717         HRLI    E,(E)
2718         ADD     E,TD.AGC+1
2719         HRRZS   C,A             ; FLUSH COUNT AND SAVE
2720         SKIPL   E               ; WITHIN BOUNDS
2721         FATAL   BAD SAT IN AGC
2722         PUSHJ   P,GETLNT        ; GOODIE IS NOW MARKED
2723         JRST    TMPREL          ; ALREADY MARKED
2724
2725         SKIPE   (E)
2726         JRST    USRAGC
2727         SUB     E,TD.AGC+1      ; POINT TO LENGTH
2728         ADD     E,TD.LNT+1
2729         XCT     (E)             ; RET # OF ELEMENTS IN B
2730
2731         HLRZ    D,B             ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
2732         PUSH    P,[0]           ; TEMP USED IF RESTS EXIST
2733         PUSH    P,D
2734         MOVEI   B,(B)           ; ZAP TO ONLY LENGTH
2735         PUSH    P,C             ; SAVE POINTER TO TEMPLATE STRUCTURE
2736         PUSH    P,[0]           ; HOME FOR VALUES
2737         PUSH    P,[0]           ; SLOT FOR TEMP
2738         PUSH    P,B             ; SAVE
2739         SUB     E,TD.LNT+1
2740         PUSH    P,E             ; SAVE FOR FINDING OTHER TABLES
2741         JUMPE   D,TD.MR2        ; NO REPEATING SEQ
2742         ADD     E,TD.GET+1      ; COMP LNTH OF REPEATING SEQ
2743         HLRE    E,(E)           ; E ==> - LNTH OF TEMPLATE
2744         ADDI    E,(D)           ; E ==> -LENGTH OF REP SEQ
2745         MOVNS   E
2746         HRLM    E,-5(P)         ; SAVE IT AND BASIC
2747
2748 TD.MR2: SKIPG   D,-1(P)         ; ANY LEFT?
2749         JRST    TD.MR1
2750
2751         MOVE    E,TD.GET+1
2752         ADD     E,(P)
2753         MOVE    E,(E)           ; POINTER TO VECTOR IN E
2754         MOVEM   D,-6(P)         ; SAVE ELMENT #
2755         SKIPN   B,-5(P)         ; SKIP IF "RESTS" EXIST
2756         SOJA    D,TD.MR3
2757
2758         MOVEI   0,(B)           ; BASIC LNT TO 0
2759         SUBI    0,(D)           ; SEE IF PAST BASIC
2760         JUMPGE  0,.-3           ; JUMP IF O.K.
2761         MOVSS   B               ; REP LNT TO RH, BASIC TO LH
2762         IDIVI   0,(B)           ; A==> -WHICH REPEATER
2763         MOVNS   A
2764         ADD     A,-5(P)         ; PLUS BASIC
2765         ADDI    A,1             ; AND FUDGE
2766         MOVEM   A,-6(P)         ; SAVE FOR PUTTER
2767         ADDI    E,-1(A)         ; POINT
2768         SOJA    D,.+2
2769
2770 TD.MR3: ADDI    E,(D)           ; POINT TO SLOT
2771         XCT     (E)             ; GET THIS ELEMENT INTO A AND B
2772         JFCL                    ; NO-OP FOR ANY CASE
2773         MOVEM   A,-3(P)         ; SAVE TYPE FOR LATER PUT
2774         MOVEM   B,-2(P)
2775         EXCH    A,B             ; REARRANGE
2776         GETYP   B,B
2777         MOVEI   C,-3(P)         ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG
2778         MOVSI   D,400000        ; RESET FOR MARK
2779         PUSHJ   P,MARK          ; AND MARK THIS GUY (RET FIXED POINTER IN A)
2780         MOVE    C,-4(P)         ; REGOBBLE POINTER TO TEMPLATE
2781         MOVE    E,TD.PUT+1
2782         MOVE    B,-6(P)         ; RESTORE COUNT
2783         ADD     E,(P)
2784         MOVE    E,(E)           ; POINTER TO VECTOR IN E
2785         ADDI    E,(B)-1         ; POINT TO SLOT
2786         MOVE    B,-3(P)         ; RESTORE TYPE WORD
2787         EXCH    A,B
2788         SOS     D,-1(P)         ; GET ELEMENT #
2789         XCT     (E)             ; SMASH IT BACK
2790         FATAL TEMPLATE LOSSAGE
2791         MOVE    C,-4(P)         ; RESTORE POINTER IN CASE MUNGED
2792         JRST    TD.MR2
2793
2794 TD.MR1: MOVE    A,-8(P)         ; PTR TO DOPE WORD
2795         MOVE    E,-7(P)         ; RESTORE PTR TO FRONTEIR
2796         SUB     P,[7,,7]        ; CLEAN UP STACK
2797 USRAG1: ADDI    A,1             ; POINT TO SECOND D.W.
2798         MOVSI   D,400000        ; SET UP MARK BIT
2799         PUSHJ   P,ADPMOD
2800         PUSHJ   P,TRBLK         ; SEND IT OUT
2801 TMPREL: SUB     P,[1,,1]
2802         HRRZ    D,(A)
2803         SUBI    D,(A)
2804         ADDM    D,(P)
2805         MOVSI   D,400000        ; RESTORE MARK/UNMARK BIT
2806         JRST    GCRET
2807
2808 USRAGC: HRRZ    E,(E)           ; MARK THE TEMPLATE
2809         PUSHJ   P,(E)
2810         MOVE    A,-1(P)         ; POINTER TO D.W
2811         MOVE    E,(P)           ; TOINTER TO FRONTIER
2812         JRST    USRAG1
2813
2814 ;  This phase attempts to remove any unwanted associations.  The program
2815 ; loops through the structure marking values of associations.  It can only
2816 ; stop when no new values (potential items and/or indicators) are marked.
2817
2818 VALFLS: PUSH    P,LPVP          ; SAVE LPVP FOR LATER
2819         PUSH    P,[0]           ; INDICATE WHETHER ANY ON THIS PASS
2820         PUSH    P,[0]           ; OR THIS BUCKET
2821 ASOMK1: MOVE    A,GCASOV        ; GET VECTOR POINTER
2822         SETOM   -1(P)           ; INITIALIZE FLAG
2823
2824 ASOM6:  SKIPG   C,(A)           ; SKIP IF BUCKET TO BE SCANNED
2825         JRST    ASOM1
2826         SETOM   (P)             ; SAY BUCKET NOT CHANGED
2827
2828 ASOM2:  MOVEI   F,(C)           ; COPY POINTER
2829         SKIPG   ASOLNT+1(C)     ; SKIP IF NOT ALREADY MARKED
2830         JRST    ASOM4           ; MARKED, GO ON
2831         PUSHJ   P,MARKQ         ; SEE IF ITEM IS MARKED
2832         JRST    ASOM3           ; IT IS NOT, IGNORE IT
2833         MOVEI   F,(C)           ; IN CASE CLOBBERED BY MARK2
2834         MOVEI   C,INDIC(C)              ; POINT TO INDICATOR SLOT
2835         PUSHJ   P,MARKQ
2836         JRST    ASOM3           ; NOT MARKED
2837
2838         PUSH    P,A             ; HERE TO MARK VALUE
2839         PUSH    P,F
2840         HLRE    F,ASOLNT-INDIC+1(C)     ; GET LENGTH
2841         JUMPL   F,.+3           ; SKIP IF MARKED
2842         CAMGE   C,VECBOT        ; SKIP IF IN VECT SPACE
2843         JRST    ASOM20
2844         HRRM    FPTR,ASOLNT-INDIC+1(C)  ; PUT IN RELATIVISATION
2845         MOVEI   F,12            ; AMOUNT TO ALLOCATE IN INF
2846         PUSHJ   P,ALLOGC
2847         HRRM    0,5(C)          ; STICK IN RELOCATION
2848
2849 ASOM20: PUSHJ   P,MARK2         ; AND MARK
2850         MOVEM   A,1(C)          ; LIST FIX UP
2851         ADDI    C,ITEM-INDIC    ; POINT TO ITEM
2852         PUSHJ   P,MARK2
2853         MOVEM   A,1(C)
2854         ADDI    C,VAL-ITEM      ; POINT TO VALUE
2855         PUSHJ   P,MARK2
2856         MOVEM   A,1(C)
2857         IORM    D,ASOLNT-VAL+1(C)       ; MARK ASOC BLOCK
2858         POP     P,F
2859         POP     P,A
2860         AOSA    -1(P)           ; INDICATE A MARK TOOK PLACE
2861
2862 ASOM3:  AOS     (P)             ; INDICATE AN UNMARKED IN THIS BUCKET
2863 ASOM4:  HRRZ    C,ASOLNT-1(F)   ; POINT TO NEXT IN BUCKET
2864         JUMPN   C,ASOM2         ; IF NOT EMPTY, CONTINUE
2865         SKIPGE  (P)             ; SKIP IF ANY NOT MARKED
2866         HRROS   (A)             ; MARK BUCKET AS NOT INTERESTING
2867 ASOM1:  AOBJN   A,ASOM6         ; GO TO NEXT BUCKET
2868         TLZE    TYPNT,.ATOM.    ; ANY ATOMS MARKED?
2869         JRST    VALFLA          ; YES, CHECK VALUES
2870 VALFL8:
2871
2872 ; NOW SEE WHICH CHANNELS STILL POINTED TO
2873
2874 CHNFL3: MOVEI   0,N.CHNS-1
2875         MOVEI   A,CHNL1 ; SLOTS
2876         HRLI    A,TCHAN         ; TYPE HERE TOO
2877
2878 CHNFL2: SKIPN   B,1(A)
2879         JRST    CHNFL1
2880         HLRE    C,B
2881         SUBI    B,(C)           ; POINT TO DOPE
2882         HLLM    A,(A)           ; PUT TYPE BACK
2883         HRRE    F,(A)           ; SEE IF ALREADY MARKED
2884         JUMPN   F,CHNFL1
2885         SKIPGE  1(B)
2886         JRST    CHNFL8
2887         HLLOS   (A)             ; MARK AS A LOSER
2888         SETZM   -1(P)
2889         JRST    CHNFL1
2890 CHNFL8: MOVEI   F,1     ; MARK A GOOD CHANNEL
2891         HRRM    F,(A)
2892 CHNFL1: ADDI    A,2
2893         SOJG    0,CHNFL2
2894
2895         SKIPE   GCHAIR          ; IF NOT HAIRY CASE
2896         POPJ    P,              ; LEAVE
2897
2898         SKIPL   -1(P)           ; SKIP IF NOTHING NEW MARKED
2899         JRST    ASOMK1
2900
2901         SUB     P,[2,,2]        ; REMOVE FLAGS
2902
2903
2904
2905 ; HERE TO REEMOVE UNUSED ASSOCIATIONS
2906
2907         MOVE    A,GCASOV        ; GET ASOVEC BACK FOR FLUSHES
2908
2909 ASOFL1: SKIPN   C,(A)           ; SKIP IF BUCKET NOT EMPTY
2910         JRST    ASOFL2          ; EMPTY BUCKET, IGNORE
2911         HRRZS   (A)             ; UNDO DAMAGE OF BEFORE
2912
2913 ASOFL5: SKIPGE  ASOLNT+1(C)     ; SKIP IF UNMARKED
2914         JRST    ASOFL6          ; MARKED, DONT FLUSH
2915
2916         HRRZ    B,ASOLNT-1(C)   ; GET FORWARD POINTER
2917         HLRZ    E,ASOLNT-1(C)   ; AND BACK POINTER
2918         JUMPN   E,ASOFL4        ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)
2919         HRRZM   B,(A)           ; FIX BUCKET
2920         JRST    .+2
2921
2922 ASOFL4: HRRM    B,ASOLNT-1(E)   ; FIX UP PREVIOUS
2923         JUMPE   B,.+2           ; JUMP IF NO NEXT POINTER
2924         HRLM    E,ASOLNT-1(B)   ; FIX NEXT'S BACK POINTER
2925         HRRZ    B,NODPNT(C)     ; SPLICE OUT THRAD
2926         HLRZ    E,NODPNT(C)
2927         SKIPE   E
2928         HRRM    B,NODPNT(E)
2929         SKIPE   B
2930         HRLM    E,NODPNT(B)
2931
2932 ASOFL3: HRRZ    C,ASOLNT-1(C)   ; GO TO NEXT
2933         JUMPN   C,ASOFL5
2934 ASOFL2: AOBJN   A,ASOFL1
2935
2936
2937 \f
2938 ; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES
2939
2940         MOVE    A,GCGBSP        ; GET GLOBAL PDL
2941
2942 GLOFLS: SKIPGE  (A)             ; SKIP IF NOT ALREADY MARKED
2943         JRST    SVDCL
2944         MOVSI   B,-3
2945         PUSHJ   P,ZERSLT        ; CLOBBER THE SLOT
2946         HLLZS   (A)
2947 SVDCL:  ANDCAM  D,(A)           ; UNMARK
2948         ADD     A,[4,,4]
2949         JUMPL   A,GLOFLS        ; MORE?, KEEP LOOPING
2950
2951         MOVEM   LPVP,(P)
2952 LOCFL1: HRRZ    A,(LPVP)        ; NOW CLOBBER LOCAL SLOTS
2953         HRRZ    C,2(LPVP)
2954         MOVEI   LPVP,(C)
2955         JUMPE   A,LOCFL2        ; NONE TO FLUSH
2956
2957 LOCFLS: SKIPGE  (A)             ; MARKDE?
2958         JRST    .+3
2959         MOVSI   B,-5
2960         PUSHJ   P,ZERSLT
2961         ANDCAM  D,(A)           ;UNMARK
2962         HRRZ    A,(A)           ; GO ON
2963         JUMPN   A,LOCFLS
2964 LOCFL2: JUMPN   LPVP,LOCFL1     ; JUMP IF MORE PROCESS
2965
2966 ; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT.
2967 ; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING.  IT FIXES UP THE SP-CHAIN AND IT
2968 ; SENDS OUT THE ATOMS.
2969
2970 LOCFL3: MOVE    C,(P)
2971         MOVEI   B,TATOM         ; MARK THE BINDING TO THIS PROCESS
2972         PUSHJ   P,MARK1         ; MARK THE ATOM
2973         MOVEM   A,1(C)          ; NEW HOME
2974         MOVEI   C,2(C)          ; MARK VALUE
2975         MOVEI   B,TPVP          ; IT IS A PROCESS VECTOR POINTER
2976         PUSHJ   P,MARK1         ; MARK IT
2977         MOVEM   A,1(C)
2978         POP     P,R
2979 NEXPRO: MOVEI   0,TPVP          ; FIX UP SLOT
2980         HLRZ    A,2(R)          ; GET PTR TO NEXT PROCESS
2981         HRLM    0,2(R)
2982         HRRZ    E,(A)           ; ADRESS IN INF
2983         HRRZ    B,(A)           ; CALCULATE RELOCATION
2984         SUB     B,A
2985         PUSH    P,B
2986         HRRZ    F,A             ; CALCULATE START OF TP IN F
2987         HLRZ    B,(A)           ; ADJUST INF PTR
2988         TRZ     B,400000
2989         SUBI    F,-1(B)
2990         LDB     M,[111100,,-1(A)]       ; CALCULATE TOP GROWTH
2991         TRZE    M,400           ; FUDGE SIGN
2992         MOVNS   M
2993         ASH     M,6
2994         ADD     B,M             ; FIX UP LENGTH
2995         EXCH    M,(P)
2996         SUBM    M,(P)           ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH
2997         MOVE    M,R             ; GET A COPY OF R
2998 NEXP1:  HRRZ    C,(M)           ; GET PTR TO NEXT IN CHAIN
2999         JUMPE   C,NEXP2         ; EXIT IF END OF CHAIN
3000         MOVE    0,C             ; GET COPY OF CHAIN PTR TO UPDATE
3001         ADD     0,(P)           ; UPDATE
3002         HRRM    0,(M)           ; PUT IN
3003         MOVE    M,C             ; NEXT
3004         JRST    NEXP1
3005 NEXP2:  SUB     P,[1,,1]        ; CLEAN UP STACK
3006         SUBI    E,-1(B)
3007         HRRI    B,(R)           ; GET POINTER TO THIS-PROCESS BINDING
3008         MOVEI   B,6(B)          ; POINT AFTER THE BINDING
3009         MOVE    0,F             ; CALCULATE # OF WORDS TO SEND OUT
3010         SUBM    B,0
3011         PUSH    P,R             ; PRESERVE R
3012         PUSHJ   P,TRBLKX                ; SEND IT OUT
3013         POP     P,R             ; RESTORE R
3014         HRRZS   R,2(R)          ; GET THE NEXT PROCESS
3015         SKIPN   R
3016         JRST    .+3
3017         PUSH    P,R
3018         JRST    LOCFL3
3019         MOVE    A,GCGBSP        ; PTR TO GLOBAL STACK
3020         PUSHJ   P,SPCOUT        ; SEND IT OUT
3021         MOVE    A,GCASOV
3022         PUSHJ   P,SPCOUT        ; SEND IT OUT
3023         POPJ    P,
3024
3025 ; THIS ROUTINE MARKS ALL THE CHANNELS
3026 ; IT THEN SENDS OUT A COPY OF THE TVP
3027
3028 CHFIX:  MOVEI   0,N.CHNS-1
3029         MOVEI   A,CHNL1         ; SLOTS
3030         HRLI    A,TCHAN         ; TYPE HERE TOO
3031
3032 DHNFL2: SKIPN   B,1(A)
3033         JRST    DHNFL1
3034         MOVEI   C,(A)           ; MARK THE CHANNEL
3035         PUSH    P,0             ; SAVE 0
3036         PUSH    P,A             ; SAVE A
3037         PUSHJ   P,MARK2
3038         MOVEM   A,1(C)          ; ADJUST PTR
3039         POP     P,A             ; RESTORE A
3040         POP     P,0             ; RESTORE
3041 DHNFL1: ADDI    A,2
3042         SOJG    0,DHNFL2
3043         POPJ    P,
3044
3045
3046 ; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR
3047
3048 SPCOUT: HLRE    B,A
3049         SUB     A,B
3050         MOVEI   A,1(A)          ; POINT TO DOPE WORD
3051         LDB     0,[001100,,-1(A)]       ;GET GROWTH FACTOR
3052         TRZE    0,400           ;KILL SIGN BIT AND SKIP IF +
3053         MOVNS   0               ;NEGATE
3054         ASH     0,6             ;CONVERT TO NUMBER OF WORDS
3055         PUSHJ   P,DOPMOD
3056         HRRZ    E,(A)           ; GET PTR TO INF
3057         HLRZ    B,(A)           ; LENGTH
3058         TRZ     B,400000        ; GET RID OF MARK BIT
3059         SUBI    E,-1(B)
3060         ADD     E,0
3061         PUSH    P,0             ; DUMMY FOR TRBLKV
3062         PUSHJ   P,TRBLKV        ; OUT IT GOES
3063         SUB     P,[1,,1]
3064         POPJ    P,              ;RETURN
3065
3066 ASOFL6: HLRZ    E,ASOLNT-1(C)   ; SEE IF FIRST IN BUCKET
3067         JUMPN   E,ASOFL3        ; IF NOT CONTINUE
3068         HRRZ    E,ASOLNT+1(C)   ; GET PTR FROM DOPE WORD
3069         SUBI    E,ASOLNT+1      ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION
3070         HRRZM   E,(A)           ; SMASH IT IN
3071         JRST    ASOFL3
3072
3073
3074 MARK23: PUSH    P,A             ; SAVE BUCKET POINTER
3075         PUSH    P,F
3076         PUSHJ   P,MARK2
3077         MOVEM   A,1(C)
3078         POP     P,F
3079         POP     P,A
3080         AOS     -2(P)           ; MARKING HAS OCCURRED
3081         IORM    D,ASOLNT+1(C)   ; MARK IT
3082         JRST    MKD
3083
3084 \f; CHANNEL FLUSHER FOR NON HAIRY GC
3085
3086 CHNFLS: PUSH    P,[-1]
3087         SETOM   (P)             ; RESET FOR RETRY
3088         PUSHJ   P,CHNFL3
3089         SKIPL   (P)
3090         JRST    .-3             ; REDO
3091         SUB     P,[1,,1]
3092         POPJ    P,
3093
3094 ; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP
3095
3096 VALFLA: MOVE    C,GCGBSP        ; GET POINTER TO GLOBAL STACK
3097 VALFL1: SKIPL   (C)             ; SKIP IF NOT MARKED
3098         PUSHJ   P,MARKQ         ; SEE IF ATOM IS MARKED
3099         JRST    VALFL2
3100         PUSH    P,C
3101         MOVEI   B,TATOM         ; UPDATE ATOM SLOT
3102         PUSHJ   P,MARK1
3103         MOVEM   A,1(C)
3104         IORM    D,(C)
3105         AOS     -2(P)           ; INDICATE MARK OCCURRED
3106         HRRZ    B,(C)           ; GET POSSIBLE GDECL
3107         JUMPE   B,VLFL10        ; NONE
3108         CAIN    B,-1            ; MAINFIFEST
3109         JRST    VLFL10
3110         MOVEI   A,(B)
3111         MOVEI   B,TLIST
3112         MOVEI   C,0
3113         PUSHJ   P,MARK          ; MARK IT
3114         MOVE    C,(P)           ; POINT
3115         HRRM    A,(C)           ; CLOBBER UPDATE IN
3116 VLFL10: ADD     C,[2,,2]        ; BUMP TO VALUE
3117         PUSHJ   P,MARK2         ; MARK VALUE
3118         MOVEM   A,1(C)
3119         POP     P,C
3120 VALFL2: ADD     C,[4,,4]
3121         JUMPL   C,VALFL1        ; JUMP IF MORE
3122
3123         HRLM    LPVP,(P)        ; SAVE POINTER
3124 VALFL7: MOVEI   C,(LPVP)
3125         MOVEI   LPVP,0
3126 VALFL6: HRRM    C,(P)
3127
3128 VALFL5: HRRZ    C,(C)           ; CHAIN
3129         JUMPE   C,VALFL4
3130         MOVEI   B,TATOM         ; TREAT LIKE AN ATOM
3131         SKIPL   (C)             ; MARKED?
3132         PUSHJ   P,MARKQ1        ; NO, SEE
3133         JRST    VALFL5          ; LOOP
3134         AOS     -1(P)           ; MARK WILL OCCUR
3135         MOVEI   B,TATOM         ; RELATAVIZE
3136         PUSHJ   P,MARK1
3137         MOVEM   A,1(C)
3138         IORM    D,(C)
3139         ADD     C,[2,,2]        ; POINT TO VALUE
3140         PUSHJ   P,MARK2         ; MARK VALUE
3141         MOVEM   A,1(C)
3142         SUBI    C,2
3143         JRST    VALFL5
3144
3145 VALFL4: HRRZ    C,(P)           ; GET SAVED LPVP
3146         MOVEI   A,(C)
3147         HRRZ    C,2(C)          ; POINT TO NEXT
3148         JUMPN   C,VALFL6
3149         JUMPE   LPVP,VALFL9
3150
3151         HRRM    LPVP,2(A)       ; NEW PROCESS WAS MARKED
3152         JRST    VALFL7
3153
3154 ZERSLT: HRRI    B,(A)           ; COPY POINTER
3155         SETZM   1(B)
3156         AOBJN   B,.-1
3157         POPJ    P,
3158
3159 VALFL9: HLRZ    LPVP,(P)        ; RESTORE CHAIN
3160         JRST    VALFL8
3161
3162 \f;SUBROUTINE TO SEE IF A GOODIE IS MARKED
3163 ;RECEIVES POINTER IN C
3164 ;SKIPS IF MARKED NOT OTHERWISE
3165
3166 MARKQ:  HLRZ    B,(C)           ;TYPE TO B
3167 MARKQ1: MOVE    E,1(C)          ;DATUM TO C
3168         MOVEI   0,(E)
3169         CAIL    0,@PURBOT       ; DONT CHACK PURE
3170         JRST    MKD             ; ALWAYS MARKED
3171         ANDI    B,TYPMSK        ; FLUSH MONITORS
3172         LSH     B,1
3173         HRRZ    B,@TYPNT        ;GOBBLE SAT
3174         ANDI    B,SATMSK
3175         CAIG    B,NUMSAT        ; SKIP FOR TEMPLATE
3176         JRST    @MQTBS(B)       ;DISPATCH
3177         ANDI    E,-1            ; FLUSH REST HACKS
3178         JRST    VECMQ
3179
3180
3181 MQTBS:
3182
3183 OFFSET 0
3184
3185 DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
3186 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ]
3187 [SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]
3188 [SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ]
3189 [SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]]
3190
3191 OFFSET OFFS
3192
3193 PAIRMQ: JUMPE   E,MKD           ; NIL ALWAYS MARKED
3194         SKIPL   (E)             ; SKIP IF MARKED
3195         POPJ    P,
3196 ARGMQ:
3197 MKD:    AOS     (P)
3198         POPJ    P,
3199
3200 BYTMQ:  PUSH    P,A             ; SAVE A
3201         PUSHJ   P,BYTDOP                ; GET PTR TO DOPE WORD
3202         MOVE    E,A             ; COPY POINTER
3203         POP     P,A             ; RESTORE A
3204         SKIPGE  (E)             ; SKIP IF NOT MARKED
3205         AOS     (P)
3206         POPJ    P,              ; EXIT
3207
3208 FRMQ:   HRRZ    E,(C)           ; POINT TO PV DOPE WORD
3209         SOJA    E,VECMQ1
3210
3211 ATMMQ:  CAML    0,GCSBOT        ; ALWAYS KEEP FROZEN ATOMS
3212         JRST    VECMQ
3213         AOS     (P)
3214         POPJ    P,
3215
3216 VECMQ:  HLRE    0,E             ;GET LENGTH
3217         SUB     E,0             ;POINT TO DOPE WORDS
3218
3219 VECMQ1: SKIPGE  1(E)            ;SKIP IF NOT MARKED
3220         AOS     (P)             ;MARKED, CAUSE SKIP RETURN
3221         POPJ    P,
3222
3223 ASMQ:   ADDI    E,ASOLNT
3224         JRST    VECMQ1
3225
3226 LOCMQ:  HRRZ    0,(C)           ; GET TIME
3227         JUMPE   0,VECMQ         ; GLOBAL, LIKE VECTOR
3228         HLRE    0,E             ; FIND DOPE
3229         SUB     E,0
3230         MOVEI   E,1(E)          ; POINT TO LAST DOPE
3231         CAMN    E,TPGROW                ; GROWING?
3232         SOJA    E,VECMQ1        ; YES, CHECK
3233         ADDI    E,PDLBUF        ; FUDGE
3234         MOVSI   0,-PDLBUF
3235         ADDM    0,1(C)
3236         SOJA    E,VECMQ1
3237
3238 OFFSMQ: HLRZS   E               ; POINT TO LIST STRUCTURE
3239         SKIPGE  (E)             ; MARKED?
3240          AOS    (P)             ; YES
3241         POPJ    P,
3242
3243 \f; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF
3244
3245 ASSOUP: MOVE    A,GCNOD         ; RECOVER PTR TO START OF CHAIN
3246 ASSOP1: HRRZ    B,NODPNT(A)
3247         PUSH    P,B             ; SAVE NEXT ON CHAIN
3248         PUSH    P,A             ; SAVE IT
3249         HRRZ    B,ASOLNT-1(A)   ;POINT TO NEXT
3250         JUMPE   B,ASOUP1
3251         HRRZ    C,ASOLNT+1(B)   ;AND GET ITS RELOC IN C
3252         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
3253         ADDM    C,ASOLNT-1(A)   ;C NOW HAS UPDATED POINTER
3254 ASOUP1: HLRZ    B,ASOLNT-1(A)   ;GET PREV BLOCK POINTER
3255         JUMPE   B,ASOUP2
3256         HRRZ    F,ASOLNT+1(B)   ;AND ITS RELOCATION
3257         SUBI    F,ASOLNT+1(B)   ; RELATIVIZE
3258         MOVSI   F,(F)
3259         ADDM    F,ASOLNT-1(A)   ;RELOCATE
3260 ASOUP2: HRRZ    B,NODPNT(A)             ;UPDATE NODE CHAIN
3261         JUMPE   B,ASOUP4
3262         HRRZ    C,ASOLNT+1(B)           ;GET RELOC
3263         SUBI    C,ASOLNT+1(B)   ; RELATIVIZE
3264         ADDM    C,NODPNT(A)     ;AND UPDATE
3265 ASOUP4: HLRZ    B,NODPNT(A)     ;GET PREV POINTER
3266         JUMPE   B,ASOUP5
3267         HRRZ    F,ASOLNT+1(B)   ;RELOC
3268         SUBI    F,ASOLNT+1(B)
3269         MOVSI   F,(F)
3270         ADDM    F,NODPNT(A)
3271 ASOUP5: POP     P,A             ; RECOVER PTR TO DOPE WORD
3272         MOVEI   A,ASOLNT+1(A)
3273         MOVSI   B,400000        ;UNMARK IT
3274         XORM    B,(A)
3275         HRRZ    E,(A)           ; SET UP PTR TO INF
3276         HLRZ    B,(A)
3277         SUBI    E,-1(B)         ; ADJUST PTR
3278         PUSHJ   P,ADPMOD
3279         PUSHJ   P,TRBLK         ; OUT IT GOES
3280         POP     P,A             ; RECOVER PTR TO ASSOCIATION
3281         JUMPN   A,ASSOP1        ; IF NOT ZERO CONTINUP
3282         POPJ    P,              ; DONE
3283
3284 \f
3285 ; HERE TO CLEAN UP ATOM HASH TABLE
3286
3287 ATCLEA: MOVE    A,GCHSHT        ; GET TABLE POINTER
3288
3289 ATCLE1: MOVEI   B,0
3290         SKIPE   C,(A)           ; GET NEXT
3291         JRST    ATCLE2          ; GOT ONE
3292
3293 ATCLE3: PUSHJ   P,OUTATM
3294         AOBJN   A,ATCLE1
3295
3296         MOVE    A,GCHSHT        ; MOVE OUT TABLE
3297         PUSHJ   P,SPCOUT
3298         POPJ    P,
3299
3300 ; HAVE AN ATOM IN C
3301
3302 ATCLE2: MOVEI   B,0
3303
3304 ATCLE5: CAIL    C,HIBOT
3305         JRST    ATCLE3
3306         CAMG    C,VECBOT        ; FROZEN ATOMS ALWAYS MARKED
3307          JRST   .+3
3308         SKIPL   1(C)            ; SKIP IF ATOM MARKED
3309         JRST    ATCLE6
3310
3311         HRRZ    0,1(C)          ; GET DESTINATION
3312         CAIN    0,-1            ; FROZEN/MAGIC ATOM
3313          MOVEI  0,1(C)          ; USE CURRENT POSN
3314         SUBI    0,1             ; POINT TO CORRECT DOPE
3315         JUMPN   B,ATCLE7        ; JUMP IF GOES INTO ATOM
3316
3317         HRRZM   0,(A)           ; INTO HASH TABLE
3318         JRST    ATCLE8
3319
3320 ATCLE7: HRLM    0,2(B)          ; INTO PREV ATOM
3321         PUSHJ   P,OUTATM
3322
3323 ATCLE8: HLRZ    B,1(C)
3324         ANDI    B,377777        ; KILL MARK BIT
3325         SUBI    B,2
3326         HRLI    B,(B)
3327         SUBM    C,B
3328         HLRZ    C,2(B)
3329         JUMPE   C,ATCLE3        ; DONE WITH BUCKET
3330         JRST    ATCLE5
3331
3332 ; HERE TO PASS OVER LOST ATOM
3333
3334 ATCLE6: HLRZ    F,1(C)          ; FIND NEXT ATOM
3335         SUBI    C,-2(F)
3336         HLRZ    C,2(C)
3337         JUMPE   B,ATCLE9
3338         HRLM    C,2(B)
3339         JRST    .+2
3340 ATCLE9: HRRZM   C,(A)
3341         JUMPE   C,ATCLE3
3342         JRST    ATCLE5
3343
3344 OUTATM: JUMPE   B,CPOPJ
3345         PUSH    P,A
3346         PUSH    P,C
3347         HLRE    A,B
3348         SUBM    B,A
3349         MOVSI   D,400000        ;UNMARK IT
3350         XORM    D,1(A)
3351         HRRZ    E,1(A)          ; SET UP PTR TO INF
3352         HLRZ    B,1(A)
3353         SUBI    E,-1(B)         ; ADJUST PTR
3354         MOVEI   A,1(A)
3355         PUSHJ   P,ADPMOD
3356         PUSHJ   P,TRBLK         ; OUT IT GOES
3357         POP     P,C
3358         POP     P,A             ; RECOVER PTR TO ASSOCIATION
3359         POPJ    P,
3360
3361 \f
3362 VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH
3363
3364
3365 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
3366
3367 MSGGCT: [ASCIZ /USER CALLED- /]
3368         [ASCIZ /FREE STORAGE- /]
3369         [ASCIZ /TP-STACK- /]
3370         [ASCIZ /TOP-LEVEL LOCALS- /]
3371         [ASCIZ /GLOBAL VALUES- /]
3372         [ASCIZ /TYPES- /]
3373         [ASCIZ /STATIONARY IMPURE STORAGE- /]
3374         [ASCIZ /P-STACK /]
3375         [ASCIZ /BOTH STACKS BLOWN- /]
3376         [ASCIZ /PURE STORAGE- /]
3377         [ASCIZ /GC-RCALL- /]
3378
3379 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
3380
3381 GCPAT:  SPBLOK 100
3382 EGCPAT: -1
3383
3384 MSGGFT: [ASCIZ /GC-READ /]
3385         [ASCIZ /BLOAT /]
3386         [ASCIZ /GROW /]
3387         [ASCIZ /LIST /]
3388         [ASCIZ /VECTOR /]
3389         [ASCIZ /SET /]
3390         [ASCIZ /SETG /]
3391         [ASCIZ /FREEZE /]
3392         [ASCIZ /PURE-PAGE LOADER /]
3393         [ASCIZ /GC /]
3394         [ASCIZ /INTERRUPT-HANDLER /]
3395         [ASCIZ /NEWTYPE /]
3396         [ASCIZ /PURIFY /]
3397
3398 .GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL
3399 .GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX
3400 .GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP
3401 .GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB
3402 .GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG
3403 .GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN
3404 .GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR
3405
3406 \f
3407 ;LOCAL VARIABLES
3408
3409 OFFSET 0
3410
3411 IMPURE
3412 ; LOCACTIONS USED BY THE PAGE HACKER
3413
3414 DOPSV1: 0                       ;SAVED FIRST D.W.
3415 DOPSV2: 0                       ; SAVED LENGTH
3416
3417
3418 ; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS.
3419 ;
3420
3421 GCNO:   0                       ; USER-CALLED GC
3422 BSTGC:  0                       ; FREE STORAGE
3423         0                       ; BLOWN TP
3424         0                       ; TOP-LEVEL LVALS
3425         0                       ; GVALS
3426         0                       ; TYPE
3427         0                       ; STORAGE
3428         0                       ; P-STACK
3429         0                       ; BOTH STATCKS BLOWN
3430         0                       ; STORAGE
3431
3432 BSTAT:
3433 NOWFRE: 0                       ; FREE STORAGE FROM LAST GC
3434 CURFRE: 0                       ; STORAGE USED SINCE LAST GC
3435 MAXFRE: 0                       ; MAXIMUM FREE STORAGE ALLOCATED
3436 USEFRE: 0                       ; TOTAL FREE STORAGE USED
3437 NOWTP:  0                       ; TP LENGTH FROM LAST GC
3438 CURTP:  0                       ; # WORDS ON TP
3439 CTPMX:  0                       ; MAXIMUM SIZE OF TP SO FAR
3440 NOWLVL: 0                       ; # OF TOP-LEVEL LVAL-SLOTS
3441 CURLVL: 0                       ; # OF TOP-LEVEL LVALS
3442 NOWGVL: 0                       ; # OF GVAL SLOTS
3443 CURGVL: 0                       ; # OF GVALS
3444 NOWTYP: 0                       ; SIZE OF TYPE-VECTOR
3445 CURTYP: 0                       ; # OF TYPES
3446 NOWSTO: 0                       ; SIZE OF STATIONARY STORAGE
3447 CURSTO: 0                       ; STATIONARY STORAGE IN USE
3448 CURMAX: 0                       ; MAXIMUM BLOCK OF  CONTIGUOUS STORAGE
3449 NOWP:   0                       ; SIZE OF P-STACK
3450 CURP:   0                       ; #WORDS ON P
3451 CPMX:   0                       ; MAXIMUM P-STACK LENGTH SO FAR
3452 GCCAUS: 0                       ; INDICATOR FOR CAUSE OF GC
3453 GCCALL: 0                       ; INDICATOR FOR CALLER OF GC
3454
3455
3456 ; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW
3457 LVLINC: 6                       ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS
3458 GVLINC: 4                       ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS
3459 TYPIC:  1                       ; TYPE INCREMENT ASSUMED TO BE 32 TYPES
3460 STORIC: 2000                    ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE)
3461
3462
3463 RCL:    0                       ; POINTER TO LIST OF RECYCLEABLE LIST CELLS
3464 RCLV:   0                       ; POINTER TO RECYCLED VECTORS
3465 GCMONF: 0                       ; NON-ZERO SAY GIN/GOUT
3466 GCDANG: 0                       ; NON-ZERO, STORAGE IS LOW
3467 INBLOT: 0                       ; INDICATE THAT WE ARE RUNNING OIN A BLOAT
3468 GETNUM: 0                       ;NO OF WORDS TO GET
3469 RFRETP:
3470 RPTOP:  0                       ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
3471 CORTOP: 0                       ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
3472 NGCS:   8                       ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS
3473
3474 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
3475 ;AND WHEN IT WILL GET UNHAPPY
3476
3477 FREMIN: 20000                   ;MINIMUM FREE WORDS
3478
3479 ;POINTER TO GROWING PDL
3480
3481 TPGROW: 0                       ;POINTS TO A BLOWN TP
3482 PPGROW: 0                       ;POINTS TO A BLOWN PP
3483 PGROW:  0                       ;POINTS TO A BLOWN P
3484
3485 ;IN GC FLAG
3486
3487 GCFLG:  0
3488 GCFLCH: 0               ; TELL INT HANDLER TO ITIC CHARS
3489 GCHAIR: 1               ; COUNTS GCS AND TELLS WHEN TO HAIRIFY
3490 GCDOWN: 0               ; AMOUNT TO TRY AND MOVE DOWN
3491 CURPLN: 0               ; LENGTH OF CURRENTLY RUNNING PURE RSUBR
3492 PURMIN: 0               ; MINIMUM PURE STORAGE
3493
3494 ; VARS ASSOCIATED WITH BLOAT LOGIC
3495 PMIN:   200                     ; MINIMUM FOR PSTACK
3496 PGOOD:  1000                    ; GOOD SIZE FOR PSTACK
3497 PMAX:   4000                    ; MAX SIZE FOR PSTACK
3498 TPMIN:  1000                    ; MINIMUM SIZE FOR TP
3499 TPGOOD: NTPGOO                  ; GOOD SIZE OF TP
3500 TPMAX:  NTPMAX                  ; MAX SIZE OF TP
3501
3502 TPBINC: 0
3503 GLBINC: 0
3504 TYPINC: 0
3505
3506 ; VARS FOR PAGE WINDOW HACKS
3507
3508 GCHSHT: 0                       ; SAVED ATOM TABLE
3509 PURSVT: 0                       ; SAVED PURVEC TABLE
3510 GLTOP:  0                       ; SAVE GLOTOP
3511 GCNOD:  0                       ; PTR TO START OF ASSOCIATION CHAIN
3512 GCGBSP: 0                       ; SAVED GLOBAL SP
3513 GCASOV: 0                       ; SAVED PTR TO ASSOCIATION VECTOR
3514 GCATM:  0                       ; PTR TO IMQUOT THIS-PROCESS
3515 FNTBOT: 0                       ; BOTTOM OF FRONTEIR
3516 WNDBOT: 0                       ; BOTTOM OF WINDOW
3517 WNDTOP: 0
3518 BOTNEW: (FPTR)                  ; POINTER TO FRONTIER
3519 GCTIM:  0
3520 NPARBO: 0                       ; SAVED PARBOT
3521
3522 ; FLAGS TO INDICATE DUMPER IS  IN USE
3523
3524 GPURFL: 0                       ; INDICATE PURIFIER IS RUNNING
3525 GCDFLG: 0                       ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING
3526 DUMFLG: 0                       ; FLAG INDICATING DUMPER IS RUNNING
3527
3528 ; CONSTANTS FOR DUMPER,READER AND PURIFYER
3529
3530 ABOTN:  0               ; COUNTER FOR ATOMS
3531 NABOTN: 0               ; POINTER USED BY PURIFY
3532 OGCSTP: 0               ; CONTAINS OLD GCSTOP FOR READER
3533 MAPUP:  0               ; BEGINNING OF MAPPED UP PURE STUFF
3534 SAVRES: 0               ; SAVED UPDATED ITEM OF PURIFIER
3535 SAVRE2: 0               ; SAVED TYPE WORD
3536 SAVRS1: 0               ; SAVED PTR TO OBJECT
3537 INF1:   0               ; AOBJN PTR USED IN CREATING PROTECTION INF
3538 INF2:   0               ; AOBJN PTR USED IN CREATING SECOND INF
3539 INF3:   0               ; AOBJN PTR USED TO PURIFY A STRUCTURE
3540
3541 ; VARIABLES USED BY GC INTERRUPT HANDLER
3542
3543 GCHPN:  0               ; SET TO -1 EVERYTIME A GC HAS OCCURED
3544 GCKNUM: 0               ; NUMBER OF WORDS OF REQUEST TO INTERRUPT
3545
3546 ; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN
3547
3548 PSHGCF: 0
3549
3550 ; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES
3551
3552 TYPTAB: 0               ; POINTER TO TYPE TABLE
3553 NNPRI:  0               ; NUMPRI FROM DUMPED OBJECT
3554 NNSAT:  0               ; NUMSAT FROM DUMPED OBJECT
3555 TYPSAV: 0               ; SAVE PTR TO TYPE VECTOR
3556
3557 ; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING
3558
3559 BUFGC:  0               ; BUFFER FOR COPY ON WRITE HACKING
3560 PURMNG: 0               ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP
3561 RPURBT: 0               ; SAVED VALUE OF PURTOP
3562 RGCSTP: 0               ; SAVED GCSTOP
3563
3564 ; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO
3565
3566 INCORF: 0                       ; INDICATION OF UVECTOR HACKS FOR GC-DUMP
3567 PURCOR: 0                       ; INDICATION OF UVECTOR TO PURE CORE
3568                                 ; ARE NOT GENERATED
3569
3570
3571 PLODR:  0                       ; INDICATE A PLOAD IS IN OPERATION
3572 NPRFLG: 0
3573
3574 ; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR
3575
3576 MAXLEN: 0                       ; MAXIMUM RECLAIMED SLOT
3577
3578 PURE
3579
3580 OFFSET OFFS
3581
3582 CONSTANTS
3583
3584 HERE
3585
3586 CONSTANTS
3587
3588 OFFSET 0
3589
3590 ZZ==$.+1777
3591
3592 .LOP ANDCM ZZ 1777
3593
3594 ZZ1==.LVAL1
3595
3596 LOC ZZ1
3597
3598
3599 OFFSET OFFS
3600
3601 WIND:   SPBLOK  2000
3602 FRONT:  SPBLOK  2000
3603 MRKPD:  SPBLOK  1777
3604 ENDPDL: -1
3605
3606 MRKPDL=MRKPD-1
3607
3608 ENDGC:
3609
3610 OFFSET 0
3611
3612 .LOP <ASH @> WIND <,-10.>
3613 WNDP==.LVAL1
3614
3615 .LOP <ASH @> FRONT <,-10.>
3616 FRNP==.LVAL1
3617
3618 ZZ2==ENDGC-AGCLD
3619 .LOP <ASH @> ZZ2 <,-10.>
3620 LENGC==.LVAL1
3621
3622 .LOP <ASH @> LENGC <,10.>
3623 RLENGC==.LVAL1
3624
3625 .LOP <ASH @> AGCLD <,-10.>
3626 PAGEGC==.LVAL1
3627
3628 OFFSET 0
3629
3630 LOC GCST
3631 .LPUR==$.
3632
3633 END
3634