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
117 PUSHJ P,STOGC ; FIX UP FROZEN WORLD
118 PUSHJ P,SWEEP ; SWEEP WORLD
122 MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING
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)
133 SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE
135 MOVE PVP,PVPSTO+1(PVP)
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?
149 MOVEI A,15 ; OUTPUT CR/LF
153 GCCONT: POP P,D ; RESTORE ACS
164 ; THIS IS THE MARK PHASE
166 ; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS
167 ; /A POINTER TO GOODIE
169 ; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK
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
178 ANDI B,TYPMSK ; FLUSH MONITORS
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
189 GCRET: HLRZ C,(P) ; GET SAVED C
192 ; TYPE DISPATCH TABLE
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]]
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]]
242 ; ROUTINE TO MARK PAIRS
245 PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE
247 JRST BADPTR ; FATAL ERROR
248 HLRE B,(C) ; SKIP IF NOT MARKED
251 PUSHJ P,MARK1 ; MARK THE ITEM
252 HRRZ C,(C) ; GET NEXT ELEMENT OF LIST
258 ; ROUTINE TO MARK DEFERS
267 ; ROUTINE TO MARK POSSIBLE DEFERS DEF?
269 DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT
270 LSH B,1 ; COMPUTE THE SAT
273 SKIPL MKTBS(B) ; SKIP IF NOT DEFERED
275 JRST DEFMK ; GO TO DEFMK
278 ; ROUTINE TO MARK VECTORS
280 VECMK: HLRE B,A ; GET LENGTH
282 MOVEI C,1(A) ; POINT TO SECOND DOPE WORD
283 CAIL C,STOSTR ; CHECK FOR IN RANGE
289 SUBI C,-1(B) ; GET TO BEGINNING
290 VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD
292 PUSHJ P,MARK1 ; MARK IT
293 ADDI C,2 ; NEXT ELEMENT
296 ; ROUTINE TO MARK UVECTORS
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
304 HLRE F,(C) ; GET LENGTH
307 GETYP B,-1(C) ; GET TYPE
308 MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION
310 HRRZ B,@TYPNT ; GET SAT
312 MOVEI B,@MSATBS(B) ; GET JUMP LOCATION
315 SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR
318 PUSH P,F ; SAVE LENGTH
321 MOVE A,1(C) ; GET VALUE POINTER
323 SOSE -1(P) ; SKIP IF NON-ZERO
324 AOJA C,UNLOOP ; GO BACK AGAIN
325 SUB P,[2,,2] ; CLEAN OFF STACK
328 ; ROUTINE TO INDICATE A BAD POINTER
330 BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE
334 ; ROUTINE TO MARK A TPSTACK
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
345 SUBI C,-1(A) ; GO TO BEGINNING
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
352 JRST MFRAME ; MARK THE FRAME
353 CAIE B,TUBIND ; BINDING BLOCK
356 PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT
357 ADDI C,2 ; POINT TO NEXT OBJECT
360 ; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS]
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
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]
370 MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK
373 HRROI C,-FSAV+1(C) ; POINT PAST FRAME
374 JRST TPLP ; GO BACK TO START OF LOOP
376 ; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING]
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
386 SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING
388 MOVEI B,TLOCI ; GET TYPE
390 NOTLCI: ADDI C,2 ; POINT PAST BINDING
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
403 ; ROUTINE TO MARK TB POINTER
405 TBMK: HRRZS A ; CHECK FOR NIL POINTER
408 MOVE A,TPSAV(A) ; GET A TP POINTER
409 MOVEI B,TTP ; TYPE WORD
413 ; ROUTINE TO MARK AB POINTERS
415 ABMK: HLRE B,A ; GET TO FRAME
417 MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER
418 MOVEI B,TTP ; TYPE WORD
422 ; ROUTINE TO MARK FRAME POINTERS
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
432 HRRZ A,1(C) ; GET POINTER TO FRAME
435 ; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES]
437 ARGMK: HLRE B,A ; GET LENGTH
438 SUB A,B ; POINT PAST BLOCK
440 CAMLE A,GCSTOP ; SEE IF IN GCSPACE
442 HRLZ 0,(A) ; GET TYPE
443 ANDI 0,TYPMSK ; FLUSH MONITORS
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
452 ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER
457 ; ROUTINE TO MARK GLOBAL SLOTS
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
463 PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA
466 MOVEI B,TLIST ; TYPE WORD LIST
467 PUSHJ P,MARK ; MARK IT
473 SUB A,B ; A POINTS TO DOPE WORD
474 SKIPGE 1(A) ; SKIP IF NOT MARKED
475 JRST GCRET ; EXIT IF MARKED
480 SUB C,B ; IN CASE WAS DW
481 IORM D,1(A) ; MARK IT
482 HRRZ A,2(C) ; MARK OBLIST
484 JRST NOOBL ; NO IMPURE OBLIST
486 MOVEI B,TOBLS ; MARK THE OBLIST
488 NOOBL: HLRZ A,2(C) ; GET NEXT ATOM
491 HLRZ B,(C) ; GET VALUE SLOT
492 TRZ B,400000 ; TURN OFF MARK BIT
494 CAIN B,TUNBOUN ; SEE IF UNBOUND
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
503 ; ROUTINE TO MARK BYTE AND STRING POINTERS
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
509 JRST ATMSET ; IT IS AN ATOM
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
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
532 LOCMK1: MOVEI B,TVEC ; GLOBAL
533 PUSHJ P,MARK1 ; MARK VALUE
536 ; MARK ASSOCIATION BLOCK
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
548 HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN
549 JUMPN A,ASMK ; GO MARK IT
554 OFFSMK: PUSH P,$TLIST
555 HLRZ 0,1(C) ; PICK UP LIST POINTER
558 PUSHJ P,MARK2 ; MARK THE LIST
560 JRST GCRET ; AND RETURN
562 ; HERE TO MARK TEMPLATE DATA STRUCTURES
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
569 HRRZS C,A ; FLUSH COUNT AND SAVE
570 SKIPL E ; WITHIN BOUNDS
572 SKIPL 1(A) ; SEE IF MARKED
573 JRST GCRET ; IF MARKED LEAVE
578 SUB E,TD.AGC+1 ; POINT TO LENGTH
580 XCT (E) ; RET # OF ELEMENTS IN B
582 HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
583 PUSH P,[0] ; TEMP USED IF RESTS EXIST
585 MOVEI B,(B) ; ZAP TO ONLY LENGTH
586 PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE
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
595 HRLM E,-3(P) ; SAVE IT AND BASIC
597 TD.MR2: SKIPG D,-1(P) ; ANY LEFT?
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
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
613 ADD A,-3(P) ; PLUS BASIC
615 MOVEM A,-4(P) ; SAVE FOR PUTTER
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
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
632 USRAGC: XCT (E) ; MARK THE TEMPLATE
636 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
637 ; AND UPDATES PTR TO THE TABLE.
639 GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE
640 HLRE B,A ; GET TO DOPE WORD
642 SKIPGE 1(A) ; SKIP IF NOT MARKED
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
649 HLRZ C,(A) ; GET MARKING
650 TRZN C,400000 ; SKIP IF MARKED
653 SUBI A,(C) ; GO BACK ONE ATOM
655 PUSH P,A ; SAVE POINTER
656 MOVEI C,-2(E) ; SET UP POINTER
657 MOVEI B,TATOM ; GO TO MARK
663 GCRD3: SUBI A,(C) ; TO NEXT ATOM
667 ; ROUTINE TO FIX UP CHANNELS
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
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
684 FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE
688 ; THIS ROUTINE MARKS ALL THE CHANNELS
690 CHFIX: MOVEI 0,N.CHNS-1
691 MOVEI A,CHNL1 ; SLOTS
709 ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
712 FIXSEN: PUSH P,B ; SAVE TIME
713 MOVEI B,[ASCIZ /TIME= /]
714 PUSHJ P,MSGTYP ; PRINT OUT MESSAGE
716 FMPRI B,(100.0) ; CONVERT TO FIX
720 MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
722 IDIVI C,10. ; START COUNTING
726 CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER
728 FIXOUT: IDIVI C,10. ; RECOVER NUMBER
733 CAIN A,2 ; DECIMAL POINT HERE?
735 FIX1: HLRZ A,(P)-1 ; GET NUMBER
736 ADDI A,60 ; MAKE IT A CHARACTER
737 PUSHJ P,IMTYO ; OUT IT GOES
741 DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0
745 JRST FIXOUT ; CONTINUE
746 DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT
751 ; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE
752 ; RCL LIST, VECTORS ON THE RCLV LIST.
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
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
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
773 VSWEEP: HLRE A,(C) ; GET LENGTH
774 JUMPGE A,VSWP1 ; SKIP IF MARKED
775 ANDCAM D,(C) ; TURN OFF MARK BIT
777 ANDI A,377777 ; GET LENGTH PART
778 SUBI C,(A) ; GO PAST VECTOR
780 VSWP1: ADDI F,(A) ; ADD LENGTH
782 MOVEI E,(C) ; GET NEW OBJECT LOCATION
783 VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR
787 SWCONS: JUMPE E,CPOPJ
788 ADDM F,TOTCNT ; HACK TOTCNT
789 CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM
791 CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG
802 HRRZ 0,RCLV ; GET VECTOR RECYCLE
803 HRRM 0,(E) ; SMASH INTO LINKING SLOT
804 HRRZM E,RCLV ; NEW RECYCLE SLOT
812 HRRZ 0,RCL ; GET RECYCLE LIST
813 HRRZM 0,(E) ; SMASH IN
819 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
821 MSGGCT: [ASCIZ /USER CALLED- /]
822 [ASCIZ /FREE STORAGE- /]
824 [ASCIZ /TOP-LEVEL LOCALS- /]
825 [ASCIZ /GLOBAL VALUES- /]
827 [ASCIZ /STATIONARY IMPURE STORAGE- /]
829 [ASCIZ /BOTH STACKS BLOWN- /]
830 [ASCIZ /PURE STORAGE- /]
833 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
838 MSGGFT: [ASCIZ /GC-READ /]
846 [ASCIZ /PURE-PAGE LOADER /]
848 [ASCIZ /INTERRUPT-HANDLER /]
878 .LOP <ASH @> ZZ2 <,-10.>
880 .LOP <ASH @> SLENGC <10.>