<mdl.int>/amsgc.mid.107

   1 TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
   2
   3 RELOCATABLE
   4
   5 .GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS
   6 .GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO
   7 .GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC
   8 .GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS
   9 .GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC
  10 .GLOBAL RSLENG
  11
  12 GCST=$.
  13
  14 LOC REALGC+RLENGC
  15
  16 OFFS=AGCLD-$.
  17 OFFSET OFFS
  18
  19 .INSRT MUDDLE >
  20
  21 TYPNT==AB
  22 F==PVP
  23
  24
  25 ; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR.  IT IS MUCH FASTER THAN THE COPYING
  26 ; GARBAGE COLLECTOR BUT DOESN'T COMPACT.  IT CONSES FREE THINGS ONTO RCL AND RCLV.
  27 ; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE
  28 ; GARBAGE COLLECT
  29
  30 \f
  31 ; FIRST INITIALIZE VARIABLES
  32
  33 IAMSGC: SETZB   M,RCL                   ; CLEAR OUT LIST RECYCLE AND RSUBR BASE
  34         SETZM   RCLV                    ; CLEAR VECTOR RECYCLE
  35         SETZM   MAXLEN                  ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE
  36         SETOM   GCFLG                   ; A GC HAS HAPPENED
  37         SETZM   TOTCNT
  38         HLLZS   SQUPNT                  ; CLEAR OUT SQUOZE TABLE
  39
  40 ; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
  41
  42         PUSH    P,A
  43         PUSH    P,B
  44         PUSH    P,C                     ; SAVE ACS
  45         MOVEI   B,[ASCIZ /MSGIN / ]     ; PRINT GIN IF WINNING
  46         SKIPE   GCMONF
  47         PUSHJ   P,MSGTYP
  48         HRRZ    C,(P)                   ; GET CAUSE INDICATOR
  49         ADDI    B,1                     ; AOS TO GET REAL CAUS
  50         MOVEM   B,GCCAUS
  51         SKIPN   GCMONF
  52         JRST    NOMON2
  53         MOVE    B,MSGGCT(C)             ; GET CAUSE MESSAGE
  54         PUSHJ   P,MSGTYP
  55 NOMON2: HLRZ    C,(P)                   ; FIND OUT WHO CAUSED THE GC
  56         MOVEM   C,GCCALL
  57         SKIPN   GCMONF                  ; PRINT IF GCMON IS ON
  58         JRST    NOMON3
  59         MOVE    B,MSGGFT(C)             ; GET POINTER TO MESSAGE
  60         PUSHJ   P,MSGTYP
  61 NOMON3: SUB     P,[1,,1]
  62         POP     P,B                     ; RESTORE ACS
  63         POP     P,A
  64
  65 ; MOVE ACS INTO THE PVP
  66
  67         EXCH    PVP,PVSTOR+1            ; GET REAL PROCESS VECTOR
  68
  69         IRP     AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
  70         MOVEM   AC,AC!STO+1(PVP)
  71         TERMIN
  72
  73         MOVE    0,PVSTOR+1              ; GET OLD VALUE OF PVP
  74         MOVEM   0,PVPSTO+1(PVP)         ; SAVE PVP
  75         MOVE    0,DSTORE                ; SAVE D'S TYPE
  76         MOVEM   0,DSTO(PVP)
  77         MOVEM   PVP,PVSTOR+1
  78
  79 ; SET UP TYPNT TO POINT TO TYPE VECTOR
  80
  81         GETYP   E,TYPVEC                ; FIRST SEE IF TYPVEC IS A VECTOR
  82         CAIE    E,TVEC
  83         FATAL   TYPE VECTOR NOT OF TYPE VECTOR
  84         HRRZ    TYPNT,TYPVEC+1
  85         HRLI    TYPNT,B                 ; TYPNT IS NOW TYPEVECTOR(B)
  86
  87 ; NOW SET UP GCPDL AND FENCE POST PDL'S
  88
  89         MOVEI   A,(TB)
  90         MOVE    D,P                     ; SAVE P POINTER
  91         PUSHJ   P,FRMUNG
  92         MOVE    P,[-2000,,MRKPDL]       ; SET UP MARK PDL
  93         MOVEI   A,(TB)                  ; FIXUP TOP FRAME
  94         SETOM   1(TP)                   ; FENCEPOST TP
  95         SETOM   1(D)                    ; FENCEPOST P
  96
  97 ; NOW SETUP AUTO CHANNEL CLOSE
  98
  99         MOVEI   0,N.CHNS-1              ; NUMBER OF CHANNELS
 100         MOVEI   A,CHNL1                 ; FIRST CHANNEL SLOT
 101 CHNCLR: SKIPE   1(A)                    ; IS IT A CHANNEL
 102         SETZM   (A)                     ; CLEAR UP TYPE SLOT
 103         ADDI    A,2
 104         SOJG    0,CHNCLR
 105
 106 ; NOW DO MARK AND SWEEP PHASES
 107
 108         MOVSI   D,400000                ; MARK BIT
 109         MOVEI   B,TPVP                  ; GET TYPE
 110         MOVE    A,PVSTOR+1              ; GET VALUE OF CURRENT PROCESS VECTOR
 111         PUSHJ   P,MARK
 112         MOVEI   B,TPVP                  ; GET TYPE OF MAIN PROCESS VECTOR
 113         MOVE    A,MAINPR
 114         PUSHJ   P,MARK                  ; MARK
 115         PUSHJ   P,CHNFLS                ; DO CHANNEL FLUSHING
 116         PUSHJ   P,STOGC                 ; FIX UP FROZEN WORLD
 117         PUSHJ   P,SWEEP                 ; SWEEP WORLD
 118
 119 ; PRINT GOUT
 120
 121         MOVEI   B,[ASCIZ /MSGOUT /]             ; PRINT OUT ENDING MESSAGE IF GCMONING
 122         SKIPE   GCMONF
 123         PUSHJ   P,MSGTYP
 124
 125 ; RESTORE ACS
 126
 127         MOVE    PVP,PVSTOR+1            ; GET PVP
 128         IRP     AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P]
 129         MOVE    AC,AC!STO+1(PVP)
 130         TERMIN
 131
 132         SKIPN   DSTORE                  ; CLEAR OUT TYPE IF NO TYPE THERE
 133         SETZM   DSTO(PVP)
 134         MOVE    PVP,PVPSTO+1(PVP)
 135
 136 ; PRINT TIME
 137
 138         PUSH    P,A                     ; SAVE ACS
 139         PUSH    P,B
 140         PUSH    P,C
 141         PUSH    P,D
 142         PUSHJ   P,CTIME                 ; GET CURRENT CPU TIME
 143         FSBR    B,GCTIM                 ; COMPUTE TIME ELAPSED
 144         MOVEM   B,GCTIM                 ; SAVE TIME AWAY
 145         SKIPN   GCMONF                  ; PRINT IT OUT?
 146         JRST    GCCONT
 147         PUSHJ   P,FIXSEN
 148         MOVEI   A,15                    ; OUTPUT CR/LF
 149         PUSHJ   P,IMTYO
 150         MOVEI   A,12
 151         PUSHJ   P,IMTYO
 152 GCCONT: POP     P,D                     ; RESTORE ACS
 153         POP     P,C
 154         POP     P,B
 155         POP     P,A
 156         SETZM   GCFLG
 157         SETOM   GCHAPN
 158         SETOM   INTFLG
 159         PUSHJ   P,RBLDM
 160         JRST    FNMSGC                  ; DONE
 161
 162 \f
 163 ; THIS IS THE MARK PHASE
 164
 165 ; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
 166 ; /A POINTER TO GOODIE
 167 ; /B TYPE OF GOODIE
 168 ; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
 169
 170 MARK2S:
 171 MARK2:  HLRZ    B,(C)                   ; TYPE
 172 MARK1:  MOVE    A,1(C)                  ; VALUE
 173 MARK:   JUMPE   A,CPOPJ                 ; DONE IF ZERO
 174         MOVEI   0,1(A)                  ; SEE IF PURE
 175         CAML    0,PURBOT
 176         JRST    CPOPJ
 177         ANDI    B,TYPMSK                ; FLUSH MONITORS
 178         HRLM    C,(P)
 179         CAIG    B,NUMPRI                ; IS A BASIC TYPE
 180         JRST    @MTYTBS(B)              ; TYPE DISPATCH
 181         LSH     B,1                     ; NOW GET PRIMTYPE
 182         HRRZ    B,@TYPNT                ; GET PRIMTYPE
 183         ANDI    B,SATMSK                ; FLUSH DOWN TO SAT
 184         CAIG    B,NUMSAT                ; SKIP IF TEMPLATE DATA
 185         JRST    @MSATBS(B)              ; JUMP OFF SAT TABLE
 186         JRST    TD.MK
 187
 188 GCRET:  HLRZ    C,(P)                   ; GET SAVED C
 189 CPOPJ:  POPJ    P,
 190
 191 ; TYPE DISPATCH TABLE
 192 MTYTBS:
 193
 194 OFFSET 0
 195
 196 DUM1:
 197
 198 IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET]
 199 [TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET]
 200 [TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK]
 201 [TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK]
 202 [TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK]
 203 [TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK]
 204 [TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK]
 205 [TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK]
 206 [TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK]
 207 [TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET]
 208 [TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET]
 209 [TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK]
 210 [TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK]
 211 [TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET]
 212 [TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK]
 213 [TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]]
 214         IRP A,B,[XX]
 215                 LOC DUM1+A
 216                 SETZ B
 217                 .ISTOP
 218         TERMIN
 219 TERMIN
 220
 221 LOC DUM1+NUMPRI+1
 222
 223 OFFSET OFFS
 224
 225 ; SAT DISPATCH TABLE
 226
 227 MSATBS:
 228
 229 OFFSET 0
 230
 231 DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK]
 232 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK]
 233 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK]
 234 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK]
 235 [SLOCA,<SETZ ARGMK>],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMK]
 236 [SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]
 237
 238 OFFSET OFFS
 239
 240 \f
 241 ; ROUTINE TO MARK PAIRS
 242
 243 PAIRMK: MOVEI   C,(A)
 244 PAIRM1: CAMG    C,GCSTOP                ; SEE IF IN RANGE
 245         CAIGE   C,STOSTR
 246         JRST    BADPTR                  ; FATAL ERROR
 247         HLRE    B,(C)                   ; SKIP IF NOT MARKED
 248         JUMPL   B,GCRET
 249         IORM    D,(C)                   ; MARK IT
 250         PUSHJ   P,MARK1                 ; MARK THE ITEM
 251         HRRZ    C,(C)                   ; GET NEXT ELEMENT OF LIST
 252         JUMPE   C,GCRET
 253         CAML    C,PURBOT
 254         JRST    GCRET
 255         JRST    PAIRM1
 256
 257 ; ROUTINE TO MARK DEFERS
 258
 259 DEFMK:  HLRE    B,(A)
 260         JUMPL   B,GCRET
 261         MOVEI   C,(A)
 262         IORM    D,(C)
 263         PUSHJ   P,MARK1
 264         JRST    GCRET
 265
 266 ; ROUTINE TO MARK POSSIBLE DEFERS DEF?
 267
 268 DEFQMK: GETYP   B,(A)                   ; GET THE TYPE OF THE OBJECT
 269         LSH     B,1                     ; COMPUTE THE SAT
 270         HRRZ    B,@TYPNT
 271         ANDI    B,SATMSK
 272         SKIPL   MKTBS(B)                ; SKIP IF NOT DEFERED
 273         JRST    PAIRMK
 274         JRST    DEFMK                   ; GO TO DEFMK
 275
 276 \f
 277 ; ROUTINE TO MARK VECTORS
 278
 279 VECMK:  HLRE    B,A                     ; GET LENGTH
 280         SUB     A,B
 281         MOVEI   C,1(A)                  ; POINT TO SECOND DOPE WORD
 282         CAIL    C,STOSTR                ; CHECK FOR IN RANGE
 283         CAMLE   C,GCSTOP
 284         JRST    BADPTR
 285         HLRE    B,(C)
 286         JUMPL   B,GCRET
 287         IORM    D,(C)                   ; MARK IT
 288         SUBI    C,-1(B)                 ; GET TO BEGINNING
 289 VECMK1: HLRE    B,(C)                   ; GET TYPE AND SKIP IF NOT DOPE WORD
 290         JUMPL   B,GCRET                 ; DONE
 291         PUSHJ   P,MARK1                 ; MARK IT
 292         ADDI    C,2                     ; NEXT ELEMENT
 293         JRST    VECMK1
 294
 295 ; ROUTINE TO MARK UVECTORS
 296
 297 UVMK:   HLRE    B,A                     ; GET LENGTH
 298         SUB     A,B                     ; A POINTS TO FIRST DOPE WORD
 299         MOVEI   C,1(A)                  ; C POINTS TO SECOND DOPE WORD
 300         CAIL    C,STOSTR                ; CHECK FOR IN RANGE
 301         CAMLE   C,GCSTOP
 302         JRST    BADPTR
 303         HLRE    F,(C)                   ; GET LENGTH
 304         JUMPL   F,GCRET
 305         IORM    D,(C)                   ; MARK IT
 306         GETYP   B,-1(C)                 ; GET TYPE
 307         MOVEI   E,(B)                   ; COPY TYPE FOR SAT COMPUTATION
 308         LSH     B,1
 309         HRRZ    B,@TYPNT                ; GET SAT
 310         ANDI    B,SATMSK
 311         MOVEI   B,@MSATBS(B)            ; GET JUMP LOCATION
 312         CAIN    B,GCRET
 313         JRST    GCRET
 314         SUBI    C,(F)                   ; POINT TO BEGINNING OF UVECTOR
 315         SUBI    F,2
 316         JUMPE   F,GCRET
 317         PUSH    P,F                     ; SAVE LENGTH
 318         PUSH    P,E
 319 UNLOOP: MOVE    B,(P)
 320         MOVE    A,1(C)                  ; GET VALUE POINTER
 321         PUSHJ   P,MARK
 322         SOSE    -1(P)                   ; SKIP IF NON-ZERO
 323         AOJA    C,UNLOOP                ; GO BACK AGAIN
 324         SUB     P,[2,,2]                ; CLEAN OFF STACK
 325         JRST    GCRET
 326
 327 ; ROUTINE TO INDICATE A BAD POINTER
 328
 329 BADPTR: FATAL   POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
 330         JRST    GCRET
 331
 332 \f
 333 ; ROUTINE TO MARK A TPSTACK
 334
 335 TPMK:   HLRE    B,A                     ; GET LENGTH
 336         SUB     A,B                     ; A POINTS TO FIRST DOPE WORD
 337         MOVEI   C,PDLBUF+1(A)           ; C POINTS TO SECOND DOPE WORD
 338         CAIL    C,STOSTR                ; CHECK FOR IN RANGE
 339         CAMLE   C,GCSTOP
 340         JRST    BADPTR
 341         HLRE    A,(C)
 342         JUMPL   A,GCRET
 343         IORM    D,(C)                   ; MARK IT
 344         SUBI    C,-1(A)                 ; GO TO BEGINNING
 345
 346 TPLP:   HLRE    B,(C)                   ; GET TYPE AND MARKING
 347         JUMPL   B,GCRET                 ; EXIT ON FENCE-POST
 348         ANDI    B,TYPMSK                ; FLUSH MONITORS
 349         CAIE    B,TCBLK                 ; CHECK FOR FRAME
 350         CAIN    B,TENTRY
 351         JRST    MFRAME                  ; MARK THE FRAME
 352         CAIE    B,TUBIND                ; BINDING BLOCK
 353         CAIN    B,TBIND
 354         JRST    MBIND
 355         PUSHJ   P,MARK1                 ; NOTHING SPECIAL SO MARK IT
 356         ADDI    C,2                     ; POINT TO NEXT OBJECT
 357         JRST    TPLP                    ; MARK IT
 358
 359 ; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
 360
 361 MFRAME: HRROI   C,FRAMLN+FSAV-1(C)      ; POINT TO FUNCTION
 362         HRRZ    A,1(C)                  ; GET POINTER
 363         CAIL    A,STOSTR                ; SEE IF IN GC SPACE
 364         CAMLE   A,GCSTOP
 365         JRST    MFRAM1                  ; SKIP OVER IT, NOT IN GC-SPACE
 366         HRL     A,(A)                   ; GET LENGTH
 367         MOVEI   B,TVEC                  ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY]
 368         PUSHJ   P,MARK
 369 MFRAM1: MOVE    A,PSAV-FSAV+1(C)        ; MARK THE PSTACK
 370         MOVEI   B,TPDL
 371         PUSHJ   P,MARK
 372         HRROI   C,-FSAV+1(C)            ; POINT PAST FRAME
 373         JRST    TPLP                    ; GO BACK TO START OF LOOP
 374
 375 ; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
 376
 377 MBIND:  MOVEI   B,TATOM                 ; START BY MARKING THE ATOM
 378         PUSHJ   P,MARK1                 ; MARK IT
 379         ADDI    C,2                     ; POINT TO VALUE SLOT
 380         PUSHJ   P,MARK2                 ; MARK THE VALUE
 381         ADDI    C,2                     ; POINT TO DECL AND PREV BINDING
 382         MOVEI   B,TLIST                 ; MARK DECL
 383         HLRZ    A,(C)
 384         PUSHJ   P,MARK
 385         SKIPL   A,1(C)                  ; SKIP IF PREVIOUS BINDING
 386         JRST    NOTLCI
 387         MOVEI   B,TLOCI                 ; GET TYPE
 388         PUSHJ   P,MARK
 389 NOTLCI: ADDI    C,2                     ; POINT PAST BINDING
 390         JRST    TPLP
 391
 392
 393 PMK:    HLRE    B,A                     ; GET LENGTH
 394         SUB     A,B                     ; A POINTS TO FIRST DOPE WORD
 395         MOVEI   C,PDLBUF+1(A)           ; C POINTS TO SECOND DOPE WORD
 396         CAIL    C,STOSTR                ; CHECK FOR IN RANGE
 397         CAMLE   C,GCSTOP
 398         JRST    BADPTR
 399         IORM    D,(C)                   ; MARK IT
 400         JRST    GCRET
 401 \f
 402 ; ROUTINE TO MARK TB POINTER
 403
 404 TBMK:   HRRZS   A                       ; CHECK FOR NIL POINTER
 405         SKIPN   A
 406         JRST    GCRET
 407         MOVE    A,TPSAV(A)              ; GET A TP POINTER
 408         MOVEI   B,TTP                   ; TYPE WORD
 409         PUSHJ   P,MARK
 410         JRST    GCRET
 411
 412 ; ROUTINE TO MARK AB POINTERS
 413
 414 ABMK:   HLRE    B,A                     ; GET TO FRAME
 415         SUB     A,B
 416         MOVE    A,FRAMLN+TPSAV(A)       ; GET A TP POINTER
 417         MOVEI   B,TTP                   ; TYPE WORD
 418         PUSHJ   P,MARK
 419         JRST    GCRET
 420
 421 ; ROUTINE TO MARK FRAME POINTERS
 422
 423 FRMK:   HRLZ    B,A                     ; GET THE TIME
 424         HLRZ    F,OTBSAV(A)             ; GET TIME FROM FRAME
 425         CAIE    B,(F)                   ; SKIP IF TIMES AGREE
 426         JRST    GCRET                   ; IGNORE POINTER IF THEY DONT
 427         HRRZ    A,(C)                   ; GET POINTER TO PROCESS
 428         SUBI    A,1                     ; FUDGE FOR VECTOR MARKING
 429         MOVEI   B,TPVP                  ; TYPE WORD
 430         PUSHJ   P,MARK
 431         HRRZ    A,1(C)                  ; GET POINTER TO FRAME
 432         JRST    TBMK                    ; MARK IT
 433
 434 ; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
 435
 436 ARGMK:  HLRE    B,A                     ; GET LENGTH
 437         SUB     A,B                     ; POINT PAST BLOCK
 438         CAIL    A,STOSTR
 439         CAMLE   A,GCSTOP                ; SEE IF IN GCSPACE
 440         JRST    GCRET
 441         HRLZ    0,(A)                   ; GET TYPE
 442         ANDI    0,TYPMSK                ; FLUSH MONITORS
 443         CAIE    0,TENTRY
 444         CAIN    0,TCBLK
 445         JRST    ARGMK1                  ; AT FRAME
 446         CAIE    0,TINFO                 ; AT FRAME
 447         JRST    GCRET                   ; NOT A LEGAL TYPE GO AWAY
 448         HRRZ    A,1(A)                  ; POINTING TO FRAME
 449         HRL     A,(C)                   ; GET TIME
 450         JRST    TBMK
 451 ARGMK1: HRRI    A,FRAMLN(A)             ; MAKE POINTER
 452         HRL     A,(C)                   ; GET TIME
 453         JRST    TBMK
 454 \f
 455
 456 ; ROUTINE TO MARK GLOBAL SLOTS
 457
 458 GATOMK: HRRZ    B,(C)                   ; GET POSSIBLE GDECL
 459         JUMPE   B,ATOMK                 ; NONE GO TO MARK ATOM
 460         CAIN    B,-1                    ; SKIP IF NOT MANIFEST
 461         JRST    ATOMK
 462         PUSH    P,A                     ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
 463         MOVEI   C,(A)
 464         MOVEI   A,(B)
 465         MOVEI   B,TLIST                 ; TYPE WORD LIST
 466         PUSHJ   P,MARK                  ; MARK IT
 467         POP     P,A
 468         JRST    ATOMK5
 469
 470 ATOMK:
 471 ATOMK5: HLRE    B,A
 472         SUB     A,B                     ; A POINTS TO DOPE WORD
 473         SKIPGE  1(A)                    ; SKIP IF NOT MARKED
 474         JRST    GCRET                   ; EXIT IF MARKED
 475         HLRZ    B,1(A)
 476         SUBI    B,3
 477         HRLI    B,1(B)
 478         MOVEI   C,-1(A)
 479         SUB     C,B                     ; IN CASE WAS DW
 480         IORM    D,1(A)                  ; MARK IT
 481         HRRZ    A,2(C)                  ; MARK OBLIST
 482         CAMG    A,VECBOT
 483         JRST    NOOBL                   ; NO IMPURE OBLIST
 484         HRLI    A,-1
 485         MOVEI   B,TOBLS                 ; MARK THE OBLIST
 486         PUSHJ   P,MARK
 487 NOOBL:  HLRZ    A,2(C)                  ; GET NEXT ATOM
 488         MOVEI   B,TATOM
 489         PUSHJ   P,MARK
 490         HLRZ    B,(C)                   ; GET VALUE SLOT
 491         TRZ     B,400000                ; TURN OFF MARK BIT
 492         SKIPE   B                       ; SEE IF 0
 493         CAIN    B,TUNBOUN               ; SEE IF UNBOUND
 494         JRST    GCRET
 495         HRRZ    0,(C)                   ; SEE IF VECTOR OR TP POINTER
 496         MOVEI   B,TVEC                  ; ASSUME VECTOR
 497         SKIPE   0                       ; SKIP IF VECTOR
 498         MOVEI   B,TTP                   ; IT IS A TP POINTER
 499         PUSHJ   P,MARK1                 ; GO MARK IT
 500         JRST    GCRET
 501 \f
 502 ; ROUTINE TO MARK BYTE AND STRING POINTERS
 503
 504 BYTMK:  PUSHJ   P,BYTDOP                ; GET TO DOPE WORD INTO A
 505         HRLZ    F,-1(A)                 ; SEE IF SPECIAL ATOM [SPNAME]
 506         ANDI    F,SATMSK                ; GET SAT
 507         CAIN    F,SATOM
 508         JRST    ATMSET                  ; IT IS AN ATOM
 509         IORM    D,(A)                   ; MARK IT
 510         JRST    GCRET
 511
 512 ATMSET: HLRZ    B,(A)                   ; GET LENGTH
 513         TRZ     B,400000                ; TURN OFF POSSIBLE MARK BIT
 514         MOVNI   B,-2(B)                 ; GENERATE AOBJN POINTER
 515         ADDI    A,-1(B)                 ; GET BACK TO BEGINNING
 516         HRLI    A,(B)                   ; PUT IN LEFT HALF
 517         MOVEI   B,TATOM                 ; MARK AS AN ATOM
 518         PUSHJ   P,MARK                  ; GO MARK
 519         JRST    GCRET
 520
 521 ; MARK LOCID GOODIES
 522
 523 LOCMK:  HRRZ    B,(C)                   ; CHECK FOR TIME
 524         JUMPE   B,LOCMK1                ; SKIP LEGAL CHECK FOR GLOBAL
 525         HRRZ    0,2(A)                  ; GET OTHER TIME
 526         CAIE    0,(B)                   ; SAME?
 527         JRST    GCRET
 528         MOVEI   B,TTP
 529         PUSHJ   P,MARK1
 530         JRST    GCRET
 531 LOCMK1: MOVEI   B,TVEC                  ; GLOBAL
 532         PUSHJ   P,MARK1                 ; MARK VALUE
 533         JRST    GCRET
 534
 535 ; MARK ASSOCIATION BLOCK
 536
 537 ASMK:   MOVEI   C,(A)                   ; SAVE POINTER TO BEGINNING OF ASSOCATION
 538         ADDI    A,ASOLNT                ; POINT TO DOPE WORD
 539         HLRE    B,1(A)                  ; GET SECOND D.W.
 540         JUMPL   B,GCRET                 ; MARKED SO LEAVE
 541         IORM    D,1(A)                  ; MARK ASSOCATION
 542         PUSHJ   P,MARK2                 ; MARK ITEM
 543         MOVEI   C,INDIC(C)
 544         PUSHJ   P,MARK2
 545         MOVEI   C,VAL-INDIC(C)
 546         PUSHJ   P,MARK2
 547         HRRZ    A,NODPNT-VAL(C)         ; GET NEXT IN CHAIN
 548         JUMPN   A,ASMK                  ; GO MARK IT
 549         JRST    GCRET
 550 \f
 551 ; MARK OFFSETS
 552
 553 OFFSMK: PUSH    P,$TLIST
 554         HLRZ    0,1(C)                  ; PICK UP LIST POINTER
 555         PUSH    P,0
 556         MOVEI   C,-1(P)
 557         PUSHJ   P,MARK2                 ; MARK THE LIST
 558         SUB     P,[2,,2]
 559         JRST    GCRET                   ; AND RETURN
 560 \f
 561 ; HERE TO MARK TEMPLATE DATA STRUCTURES
 562
 563 TD.MK:  HLRZ    B,(A)                   ; GET REAL SPEC TYPE
 564         ANDI    B,37777                 ; KILL SIGN BIT
 565         MOVEI   E,-NUMSAT-1(B)          ; GET REL POINTER TO TABLE
 566         HRLI    E,(E)
 567         ADD     E,TD.AGC+1
 568         HRRZS   C,A                     ; FLUSH COUNT AND SAVE
 569         SKIPL   E                       ; WITHIN BOUNDS
 570         FATAL   BAD SAT IN AGC
 571         SKIPL   1(A)                    ; SEE IF MARKED
 572         JRST    GCRET                   ; IF MARKED LEAVE
 573         IORM    D,1(A)
 574
 575         SKIPE   (E)
 576         JRST    USRAGC
 577         SUB     E,TD.AGC+1              ; POINT TO LENGTH
 578         ADD     E,TD.LNT+1
 579         XCT     (E)                     ; RET # OF ELEMENTS IN B
 580
 581         HLRZ    D,B                     ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
 582         PUSH    P,[0]                   ; TEMP USED IF RESTS EXIST
 583         PUSH    P,D
 584         MOVEI   B,(B)                   ; ZAP TO ONLY LENGTH
 585         PUSH    P,C                     ; SAVE POINTER TO TEMPLATE STRUCTURE
 586         PUSH    P,B                     ; SAVE
 587         SUB     E,TD.LNT+1
 588         PUSH    P,E                     ; SAVE FOR FINDING OTHER TABLES
 589         JUMPE   D,TD.MR2                ; NO REPEATING SEQ
 590         ADD     E,TD.GET+1              ; COMP LNTH OF REPEATING SEQ
 591         HLRE    E,(E)                   ; E ==> - LNTH OF TEMPLATE
 592         ADDI    E,(D)                   ; E ==> -LENGTH OF REP SEQ
 593         MOVNS   E
 594         HRLM    E,-3(P)                 ; SAVE IT AND BASIC
 595
 596 TD.MR2: SKIPG   D,-1(P)                 ; ANY LEFT?
 597         JRST    TD.MR1
 598
 599         MOVE    E,TD.GET+1
 600         ADD     E,(P)
 601         MOVE    E,(E)                   ; POINTER TO VECTOR IN E
 602         MOVEM   D,-4(P)                 ; SAVE ELMENT #
 603         SKIPN   B,-3(P)                 ; SKIP IF "RESTS" EXIST
 604         SOJA    D,TD.MR3
 605
 606         MOVEI   0,(B)                   ; BASIC LNT TO 0
 607         SUBI    0,(D)                   ; SEE IF PAST BASIC
 608         JUMPGE  0,.-3                   ; JUMP IF O.K.
 609         MOVSS   B                       ; REP LNT TO RH, BASIC TO LH
 610         IDIVI   0,(B)                   ; A==> -WHICH REPEATER
 611         MOVNS   A
 612         ADD     A,-3(P)                 ; PLUS BASIC
 613         ADDI    A,1                     ; AND FUDGE
 614         MOVEM   A,-4(P)                 ; SAVE FOR PUTTER
 615         ADDI    E,-1(A)                 ; POINT
 616         SOJA    D,.+2
 617
 618 TD.MR3: ADDI    E,(D)                   ; POINT TO SLOT
 619         XCT     (E)                     ; GET THIS ELEMENT INTO A AND B
 620         JFCL                            ; NO-OP FOR ANY CASE
 621         EXCH    A,B                     ; REARRANGE
 622         HLRZS   B
 623         MOVSI   D,400000                ; RESET FOR MARK
 624         PUSHJ   P,MARK                  ; AND MARK THIS GUY (RET FIXED POINTER IN A)
 625         MOVE    C,-2(P)                 ; RESTORE POINTER IN CASE MUNGED
 626         JRST    TD.MR2
 627
 628 TD.MR1: SUB     P,[5,,5]
 629         JRST    GCRET
 630
 631 USRAGC: XCT     (E)                     ; MARK THE TEMPLATE
 632         JRST    GCRET
 633
 634 \f
 635 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
 636 ; AND UPDATES PTR TO THE TABLE.
 637
 638 GCRDMK: MOVEI   C,(A)                   ; SAVE POINTER TO GCREAD TABLE
 639         HLRE    B,A                     ; GET TO DOPE WORD
 640         SUB     A,B
 641         SKIPGE  1(A)                    ; SKIP IF NOT MARKED
 642         JRST    GCRET
 643         SUBI    A,2
 644         MOVE    B,ABOTN                 ; GET TOP OF ATOM TABLE
 645         ADD     B,0                     ; GET BOTTOM OF ATOM TABLE
 646 GCRD1:  CAMG    A,B                     ; DON'T SKIP IF DONE
 647         JRST    GCRET
 648         HLRZ    C,(A)                   ; GET MARKING
 649         TRZN    C,400000                ; SKIP IF MARKED
 650         JRST    GCRD3
 651         MOVEI   E,(A)
 652         SUBI    A,(C)                   ; GO BACK ONE ATOM
 653         PUSH    P,B                     ; SAVE B
 654         PUSH    P,A                     ; SAVE POINTER
 655         MOVEI   C,-2(E)                 ; SET UP POINTER
 656         MOVEI   B,TATOM                 ; GO TO MARK
 657         MOVE    A,1(C)
 658         PUSHJ   P,MARK
 659         POP     P,A
 660         POP     P,B
 661         JRST    GCRD1
 662 GCRD3:  SUBI    A,(C)                   ; TO NEXT ATOM
 663         JRST    GCRD1
 664
 665
 666 ; ROUTINE TO FIX UP CHANNELS
 667
 668 CHNFLS: MOVEI   0,N.CHNS-1
 669         MOVE    A,[TCHAN,,CHNL1]        ; SET UP POINTER
 670 CHFL1:  SKIPN   B,1(A)                  ; GET POINTER TO CHANNEL
 671         JRST    CHFL2                   ; NO CHANNEL LOOP TO NEXT
 672         HLRE    C,B                     ; POINT TO DOPE WORD OF CHANNEL
 673         SUBI    B,(C)
 674         HLLM    A,(A)                   ; PUT TYPE BACK
 675         SKIPL   1(B)                    ; SKIP IF MARKED
 676         JRST    FLSCH                   ; FLUSH THE CHANNEL
 677         MOVEI   F,1                     ; MARK THE CHANNEL AS GOOD
 678         HRRM    F,(A)                   ; SMASH IT IN
 679 CHFL2:  ADDI    A,2
 680         SOJG    0,CHFL1
 681         POPJ    P,                      ; EXIT
 682 FLSCH:  HLLOS   F,(A)                   ; -1 INTO SLOT INDICATES LOSSAGE
 683         JRST    CHFL2
 684
 685
 686
 687 \f
 688 ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
 689 ; POINT.
 690
 691 FIXSEN: PUSH    P,B             ; SAVE TIME
 692         MOVEI   B,[ASCIZ /TIME= /]
 693         PUSHJ   P,MSGTYP        ; PRINT OUT MESSAGE
 694         POP     P,B             ; RESTORE B
 695         FMPRI   B,(100.0)       ; CONVERT TO FIX
 696         MULI    B,400
 697         TSC     B,B
 698         ASH     C,-163.(B)
 699         MOVEI   A,1             ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
 700         PUSH    P,C
 701         IDIVI   C,10.           ; START COUNTING
 702         JUMPLE  C,.+2
 703         AOJA    A,.-2
 704         POP     P,C
 705         CAIN    A,1             ; SEE IF THERE IS ONLY ONE CHARACTER
 706         JRST    DOT1
 707 FIXOUT: IDIVI   C,10.           ; RECOVER NUMBER
 708         HRLM    D,(P)
 709         SKIPE   C
 710         PUSHJ   P,FIXOUT
 711         PUSH    P,A             ; SAVE A
 712         CAIN    A,2             ; DECIMAL POINT HERE?
 713         JRST    DOT2
 714 FIX1:   HLRZ    A,(P)-1         ; GET NUMBER
 715         ADDI    A,60            ; MAKE IT A CHARACTER
 716         PUSHJ   P,IMTYO         ; OUT IT GOES
 717         POP     P,A
 718         SOJ     A,
 719         POPJ    P,
 720 DOT1:   MOVEI   A,".            ; OUTPUT DECIMAL POINT AND PADDING 0
 721         PUSHJ   P,IMTYO
 722         MOVEI   A,"0
 723         PUSHJ   P,IMTYO
 724         JRST    FIXOUT          ; CONTINUE
 725 DOT2:   MOVEI   A,".            ; OUTPUT DECIMAL POINT
 726         PUSHJ   P,IMTYO
 727         JRST    FIX1
 728
 729 \f
 730 ; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS.  PAIRS ARE PLACED ON THE
 731 ; RCL LIST, VECTORS ON THE RCLV LIST.
 732
 733 SWEEP:  MOVE    C,GCSTOP                ; GET TOP OF GC SPACE
 734         SUBI    C,1                     ; POINT TO FIRST OBJECT
 735         SETZB   E,F                     ; CURRENT SLOT AND CURRENT LENGTH
 736 LSWEEP: CAMG    C,GCSBOT                ; SKIP IF ABOVE GCSBOT
 737         JRST    ESWEEP                  ; DONE
 738         HLRE    A,-1(C)                 ; SEE IF LIST OR VECTOR
 739         TRNE    A,UBIT                  ; SKIP IF LIST
 740         JRST    VSWEEP                  ; IT IS A VECTOR
 741         JUMPGE  A,LSWP1                 ; JUMP IF NOT MARKED
 742         ANDCAM  D,-1(C)                 ; TURN OFF MARK BIT
 743         PUSHJ   P,SWCONS                ; CONS ON CURRENT OBJECT
 744         SUBI    C,2                     ; SKIP OVER LIST
 745         JRST    LSWEEP
 746 LSWP1:  ADDI    F,2                     ; ADD TO CURRENT OBJECT COUNT
 747         JUMPN   E,LSWP2                 ; JUMP IF CURRENT OBJECT EXISTS
 748         MOVEI   E,(C)                   ; GET ADDRESS
 749 LSWP2:  SUBI    C,2
 750         JRST    LSWEEP
 751
 752 VSWEEP: HLRE    A,(C)                   ; GET LENGTH
 753         JUMPGE  A,VSWP1                 ; SKIP IF MARKED
 754         ANDCAM  D,(C)                   ; TURN OFF MARK BIT
 755         PUSHJ   P,SWCONS
 756         ANDI    A,377777                ; GET LENGTH PART
 757         SUBI    C,(A)                   ; GO PAST VECTOR
 758         JRST    LSWEEP
 759 VSWP1:  ADDI    F,(A)                   ; ADD LENGTH
 760         JUMPN   E,VSWP2
 761         MOVEI   E,(C)                   ; GET NEW OBJECT LOCATION
 762 VSWP2:  SUBI    C,(A)                   ; GO BACK PAST VECTOR
 763         JRST    LSWEEP
 764
 765 ESWEEP:
 766 SWCONS: JUMPE   E,CPOPJ
 767         ADDM    F,TOTCNT                ; HACK TOTCNT
 768         CAMLE   F,MAXLEN                ; SEE IF NEW MAXIMUM
 769         MOVEM   F,MAXLEN
 770         CAIGE   F,2                     ; MAKE SURE AT LEAST TWO LONG
 771         FATAL   SWEEP FAILURE
 772         CAIN    F,2
 773         JRST    LCONS
 774         SETZM   (E)
 775         MOVEI   0,(E)
 776         SUBI    0,-1(F)
 777         SETZM   @0
 778         HRLS    0
 779         ADDI    0,1
 780         BLT     0,-2(E)
 781         HRRZ    0,RCLV                  ; GET VECTOR RECYCLE
 782         HRRM    0,(E)                   ; SMASH INTO LINKING SLOT
 783         HRRZM   E,RCLV                  ; NEW RECYCLE SLOT
 784         HRLM    F,(E)
 785         MOVSI   F,UBIT
 786         MOVEM   F,-1(E)
 787         SETZB   E,F
 788         POPJ    P,                      ; DONE
 789 LCONS:  SETZM   (E)
 790         SUBI    E,1
 791         HRRZ    0,RCL                   ; GET RECYCLE LIST
 792         HRRZM   0,(E)                   ; SMASH IN
 793         HRRZM   E,RCL
 794         SETZB   E,F
 795         POPJ    P,
 796
 797 \f
 798 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
 799
 800 MSGGCT: [ASCIZ /USER CALLED- /]
 801         [ASCIZ /FREE STORAGE- /]
 802         [ASCIZ /TP-STACK- /]
 803         [ASCIZ /TOP-LEVEL LOCALS- /]
 804         [ASCIZ /GLOBAL VALUES- /]
 805         [ASCIZ /TYPES- /]
 806         [ASCIZ /STATIONARY IMPURE STORAGE- /]
 807         [ASCIZ /P-STACK /]
 808         [ASCIZ /BOTH STACKS BLOWN- /]
 809         [ASCIZ /PURE STORAGE- /]
 810         [ASCIZ /GC-RCALL- /]
 811
 812 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
 813
 814 GCPAT:  SPBLOK 100
 815 EGCPAT: -1
 816
 817 MSGGFT: [ASCIZ /GC-READ /]
 818         [ASCIZ /BLOAT /]
 819         [ASCIZ /GROW /]
 820         [ASCIZ /LIST /]
 821         [ASCIZ /VECTOR /]
 822         [ASCIZ /SET /]
 823         [ASCIZ /SETG /]
 824         [ASCIZ /FREEZE /]
 825         [ASCIZ /PURE-PAGE LOADER /]
 826         [ASCIZ /GC /]
 827         [ASCIZ /INTERRUPT-HANDLER /]
 828         [ASCIZ /NEWTYPE /]
 829         [ASCIZ /PURIFY /]
 830
 831 CONSTANTS
 832
 833 HERE
 834
 835 CONSTANTS
 836
 837 OFFSET 0
 838
 839 ZZ==$.+1777
 840
 841 .LOP ANDCM ZZ 1777
 842
 843 ZZ1==.LVAL1
 844
 845 LOC ZZ1
 846
 847 OFFSET OFFS
 848
 849 MRKPDL==.-1
 850
 851 ENDGC:
 852
 853 OFFSET 0
 854
 855 ZZ2==ENDGC-AGCLD
 856
 857 .LOP <ASH @> ZZ2 <,-10.>
 858 SLENGC==.LVAL1
 859 .LOP <ASH @> SLENGC <10.>
 860 RSLENG==.LVAL1
 861 LOC GCST
 862
 863 .LPUR=$.
 864
 865 END