1 TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR
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
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
31 ; FIRST INITIALIZE VARIABLES
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
38 HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE
40 ; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER
45 MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING
48 HRRZ C,(P) ; GET CAUSE INDICATOR
49 ADDI B,1 ; AOS TO GET REAL CAUS
53 MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE
55 NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC
57 SKIPN GCMONF ; PRINT IF GCMON IS ON
59 MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE
65 ; MOVE ACS INTO THE PVP
67 EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR
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)
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
79 ; SET UP TYPNT TO POINT TO TYPE VECTOR
81 GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR
83 FATAL TYPE VECTOR NOT OF TYPE VECTOR
85 HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B)
87 ; NOW SET UP GCPDL AND FENCE POST PDL'S
90 MOVE D,P ; SAVE P POINTER
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
97 ; NOW SETUP AUTO CHANNEL CLOSE
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
106 ; NOW DO MARK AND SWEEP PHASES
108 MOVSI D,400000 ; MARK BIT
109 MOVEI B,TPVP ; GET TYPE
110 MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR
112 MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR
115 PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING
116 PUSHJ P,STOGC ; FIX UP FROZEN WORLD
117 PUSHJ P,SWEEP ; SWEEP WORLD
121 MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING
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)
132 SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE
134 MOVE PVP,PVPSTO+1(PVP)
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?
148 MOVEI A,15 ; OUTPUT CR/LF
152 GCCONT: POP P,D ; RESTORE ACS
163 ; THIS IS THE MARK PHASE
165 ; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
166 ; /A POINTER TO GOODIE
168 ; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
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
177 ANDI B,TYPMSK ; FLUSH MONITORS
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
188 GCRET: HLRZ C,(P) ; GET SAVED C
191 ; TYPE DISPATCH TABLE
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]]
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]]
241 ; ROUTINE TO MARK PAIRS
244 PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE
246 JRST BADPTR ; FATAL ERROR
247 HLRE B,(C) ; SKIP IF NOT MARKED
250 PUSHJ P,MARK1 ; MARK THE ITEM
251 HRRZ C,(C) ; GET NEXT ELEMENT OF LIST
257 ; ROUTINE TO MARK DEFERS
266 ; ROUTINE TO MARK POSSIBLE DEFERS DEF?
268 DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT
269 LSH B,1 ; COMPUTE THE SAT
272 SKIPL MKTBS(B) ; SKIP IF NOT DEFERED
274 JRST DEFMK ; GO TO DEFMK
277 ; ROUTINE TO MARK VECTORS
279 VECMK: HLRE B,A ; GET LENGTH
281 MOVEI C,1(A) ; POINT TO SECOND DOPE WORD
282 CAIL C,STOSTR ; CHECK FOR IN RANGE
288 SUBI C,-1(B) ; GET TO BEGINNING
289 VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD
291 PUSHJ P,MARK1 ; MARK IT
292 ADDI C,2 ; NEXT ELEMENT
295 ; ROUTINE TO MARK UVECTORS
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
303 HLRE F,(C) ; GET LENGTH
306 GETYP B,-1(C) ; GET TYPE
307 MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION
309 HRRZ B,@TYPNT ; GET SAT
311 MOVEI B,@MSATBS(B) ; GET JUMP LOCATION
314 SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR
317 PUSH P,F ; SAVE LENGTH
320 MOVE A,1(C) ; GET VALUE POINTER
322 SOSE -1(P) ; SKIP IF NON-ZERO
323 AOJA C,UNLOOP ; GO BACK AGAIN
324 SUB P,[2,,2] ; CLEAN OFF STACK
327 ; ROUTINE TO INDICATE A BAD POINTER
329 BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
333 ; ROUTINE TO MARK A TPSTACK
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
344 SUBI C,-1(A) ; GO TO BEGINNING
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
351 JRST MFRAME ; MARK THE FRAME
352 CAIE B,TUBIND ; BINDING BLOCK
355 PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT
356 ADDI C,2 ; POINT TO NEXT OBJECT
359 ; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
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
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]
369 MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK
372 HRROI C,-FSAV+1(C) ; POINT PAST FRAME
373 JRST TPLP ; GO BACK TO START OF LOOP
375 ; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
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
385 SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING
387 MOVEI B,TLOCI ; GET TYPE
389 NOTLCI: ADDI C,2 ; POINT PAST BINDING
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
402 ; ROUTINE TO MARK TB POINTER
404 TBMK: HRRZS A ; CHECK FOR NIL POINTER
407 MOVE A,TPSAV(A) ; GET A TP POINTER
408 MOVEI B,TTP ; TYPE WORD
412 ; ROUTINE TO MARK AB POINTERS
414 ABMK: HLRE B,A ; GET TO FRAME
416 MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER
417 MOVEI B,TTP ; TYPE WORD
421 ; ROUTINE TO MARK FRAME POINTERS
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
431 HRRZ A,1(C) ; GET POINTER TO FRAME
434 ; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
436 ARGMK: HLRE B,A ; GET LENGTH
437 SUB A,B ; POINT PAST BLOCK
439 CAMLE A,GCSTOP ; SEE IF IN GCSPACE
441 HRLZ 0,(A) ; GET TYPE
442 ANDI 0,TYPMSK ; FLUSH MONITORS
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
451 ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER
456 ; ROUTINE TO MARK GLOBAL SLOTS
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
462 PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
465 MOVEI B,TLIST ; TYPE WORD LIST
466 PUSHJ P,MARK ; MARK IT
472 SUB A,B ; A POINTS TO DOPE WORD
473 SKIPGE 1(A) ; SKIP IF NOT MARKED
474 JRST GCRET ; EXIT IF MARKED
479 SUB C,B ; IN CASE WAS DW
480 IORM D,1(A) ; MARK IT
481 HRRZ A,2(C) ; MARK OBLIST
483 JRST NOOBL ; NO IMPURE OBLIST
485 MOVEI B,TOBLS ; MARK THE OBLIST
487 NOOBL: HLRZ A,2(C) ; GET NEXT ATOM
490 HLRZ B,(C) ; GET VALUE SLOT
491 TRZ B,400000 ; TURN OFF MARK BIT
493 CAIN B,TUNBOUN ; SEE IF UNBOUND
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
502 ; ROUTINE TO MARK BYTE AND STRING POINTERS
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
508 JRST ATMSET ; IT IS AN ATOM
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
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
531 LOCMK1: MOVEI B,TVEC ; GLOBAL
532 PUSHJ P,MARK1 ; MARK VALUE
535 ; MARK ASSOCIATION BLOCK
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
547 HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN
548 JUMPN A,ASMK ; GO MARK IT
553 OFFSMK: PUSH P,$TLIST
554 HLRZ 0,1(C) ; PICK UP LIST POINTER
557 PUSHJ P,MARK2 ; MARK THE LIST
559 JRST GCRET ; AND RETURN
561 ; HERE TO MARK TEMPLATE DATA STRUCTURES
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
568 HRRZS C,A ; FLUSH COUNT AND SAVE
569 SKIPL E ; WITHIN BOUNDS
571 SKIPL 1(A) ; SEE IF MARKED
572 JRST GCRET ; IF MARKED LEAVE
577 SUB E,TD.AGC+1 ; POINT TO LENGTH
579 XCT (E) ; RET # OF ELEMENTS IN B
581 HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
582 PUSH P,[0] ; TEMP USED IF RESTS EXIST
584 MOVEI B,(B) ; ZAP TO ONLY LENGTH
585 PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE
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
594 HRLM E,-3(P) ; SAVE IT AND BASIC
596 TD.MR2: SKIPG D,-1(P) ; ANY LEFT?
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
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
612 ADD A,-3(P) ; PLUS BASIC
614 MOVEM A,-4(P) ; SAVE FOR PUTTER
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
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
631 USRAGC: XCT (E) ; MARK THE TEMPLATE
635 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
636 ; AND UPDATES PTR TO THE TABLE.
638 GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE
639 HLRE B,A ; GET TO DOPE WORD
641 SKIPGE 1(A) ; SKIP IF NOT MARKED
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
648 HLRZ C,(A) ; GET MARKING
649 TRZN C,400000 ; SKIP IF MARKED
652 SUBI A,(C) ; GO BACK ONE ATOM
654 PUSH P,A ; SAVE POINTER
655 MOVEI C,-2(E) ; SET UP POINTER
656 MOVEI B,TATOM ; GO TO MARK
662 GCRD3: SUBI A,(C) ; TO NEXT ATOM
666 ; ROUTINE TO FIX UP CHANNELS
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
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
682 FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE
688 ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
691 FIXSEN: PUSH P,B ; SAVE TIME
692 MOVEI B,[ASCIZ /TIME= /]
693 PUSHJ P,MSGTYP ; PRINT OUT MESSAGE
695 FMPRI B,(100.0) ; CONVERT TO FIX
699 MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
701 IDIVI C,10. ; START COUNTING
705 CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER
707 FIXOUT: IDIVI C,10. ; RECOVER NUMBER
712 CAIN A,2 ; DECIMAL POINT HERE?
714 FIX1: HLRZ A,(P)-1 ; GET NUMBER
715 ADDI A,60 ; MAKE IT A CHARACTER
716 PUSHJ P,IMTYO ; OUT IT GOES
720 DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0
724 JRST FIXOUT ; CONTINUE
725 DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT
730 ; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE
731 ; RCL LIST, VECTORS ON THE RCLV LIST.
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
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
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
752 VSWEEP: HLRE A,(C) ; GET LENGTH
753 JUMPGE A,VSWP1 ; SKIP IF MARKED
754 ANDCAM D,(C) ; TURN OFF MARK BIT
756 ANDI A,377777 ; GET LENGTH PART
757 SUBI C,(A) ; GO PAST VECTOR
759 VSWP1: ADDI F,(A) ; ADD LENGTH
761 MOVEI E,(C) ; GET NEW OBJECT LOCATION
762 VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR
766 SWCONS: JUMPE E,CPOPJ
767 ADDM F,TOTCNT ; HACK TOTCNT
768 CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM
770 CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG
781 HRRZ 0,RCLV ; GET VECTOR RECYCLE
782 HRRM 0,(E) ; SMASH INTO LINKING SLOT
783 HRRZM E,RCLV ; NEW RECYCLE SLOT
791 HRRZ 0,RCL ; GET RECYCLE LIST
792 HRRZM 0,(E) ; SMASH IN
798 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
800 MSGGCT: [ASCIZ /USER CALLED- /]
801 [ASCIZ /FREE STORAGE- /]
803 [ASCIZ /TOP-LEVEL LOCALS- /]
804 [ASCIZ /GLOBAL VALUES- /]
806 [ASCIZ /STATIONARY IMPURE STORAGE- /]
808 [ASCIZ /BOTH STACKS BLOWN- /]
809 [ASCIZ /PURE STORAGE- /]
812 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
817 MSGGFT: [ASCIZ /GC-READ /]
825 [ASCIZ /PURE-PAGE LOADER /]
827 [ASCIZ /INTERRUPT-HANDLER /]
857 .LOP <ASH @> ZZ2 <,-10.>
859 .LOP <ASH @> SLENGC <10.>