<mdl.int>/amsgc.mid.109

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