TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR RELOCATABLE .GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS .GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO .GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC .GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS .GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC .GLOBAL RSLENG GCST=$. LOC REALGC+RLENGC OFFS=AGCLD-$. OFFSET OFFS .INSRT MUDDLE > TYPNT==AB F==PVP ; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING ; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. ; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE ; GARBAGE COLLECT ; FIRST INITIALIZE VARIABLES IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE SETZM RCLV ; CLEAR VECTOR RECYCLE SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE SETOM GCFLG ; A GC HAS HAPPENED SETZM TOTCNT HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE ; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER PUSH P,A PUSH P,B PUSH P,C ; SAVE ACS MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING SKIPE GCMONF PUSHJ P,MSGTYP HRRZ C,(P) ; GET CAUSE INDICATOR ADDI B,1 ; AOS TO GET REAL CAUS MOVEM B,GCCAUS SKIPN GCMONF JRST NOMON2 MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE PUSHJ P,MSGTYP NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC MOVEM C,GCCALL SKIPN GCMONF ; PRINT IF GCMON IS ON JRST NOMON3 MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE PUSHJ P,MSGTYP NOMON3: SUB P,[1,,1] POP P,B ; RESTORE ACS POP P,A ; MOVE ACS INTO THE PVP EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] MOVEM AC,AC!STO+1(PVP) TERMIN MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP MOVE 0,DSTORE ; SAVE D'S TYPE MOVEM 0,DSTO(PVP) MOVEM PVP,PVSTOR+1 ; SET UP TYPNT TO POINT TO TYPE VECTOR GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR CAIE E,TVEC FATAL TYPE VECTOR NOT OF TYPE VECTOR HRRZ TYPNT,TYPVEC+1 HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) ; NOW SET UP GCPDL AND FENCE POST PDL'S MOVEI A,(TB) MOVE D,P ; SAVE P POINTER PUSHJ P,FRMUNG MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL MOVEI A,(TB) ; FIXUP TOP FRAME SETOM 1(TP) ; FENCEPOST TP SETOM 1(D) ; FENCEPOST P ; NOW SETUP AUTO CHANNEL CLOSE MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS MOVEI A,CHNL1 ; FIRST CHANNEL SLOT CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL SETZM (A) ; CLEAR UP TYPE SLOT ADDI A,2 SOJG 0,CHNCLR ; NOW DO MARK AND SWEEP PHASES MOVSI D,400000 ; MARK BIT MOVEI B,TPVP ; GET TYPE MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR PUSHJ P,MARK MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR MOVE A,MAINPR PUSHJ P,MARK ; MARK PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING PUSHJ P,CHFIX PUSHJ P,STOGC ; FIX UP FROZEN WORLD PUSHJ P,SWEEP ; SWEEP WORLD ; PRINT GOUT MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING SKIPE GCMONF PUSHJ P,MSGTYP ; RESTORE ACS MOVE PVP,PVSTOR+1 ; GET PVP IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] MOVE AC,AC!STO+1(PVP) TERMIN SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE SETZM DSTO(PVP) MOVE PVP,PVPSTO+1(PVP) ; PRINT TIME PUSH P,A ; SAVE ACS PUSH P,B PUSH P,C PUSH P,D PUSHJ P,CTIME ; GET CURRENT CPU TIME FSBR B,GCTIM ; COMPUTE TIME ELAPSED MOVEM B,GCTIM ; SAVE TIME AWAY SKIPN GCMONF ; PRINT IT OUT? JRST GCCONT PUSHJ P,FIXSEN MOVEI A,15 ; OUTPUT CR/LF PUSHJ P,IMTYO MOVEI A,12 PUSHJ P,IMTYO GCCONT: POP P,D ; RESTORE ACS POP P,C POP P,B POP P,A SETZM GCFLG SETOM GCHAPN SETOM INTFLG PUSHJ P,RBLDM JRST FNMSGC ; DONE ; THIS IS THE MARK PHASE ; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS ; /A POINTER TO GOODIE ; /B TYPE OF GOODIE ; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK MARK2S: MARK2: HLRZ B,(C) ; TYPE MARK1: MOVE A,1(C) ; VALUE MARK: JUMPE A,CPOPJ ; DONE IF ZERO MOVEI 0,1(A) ; SEE IF PURE CAML 0,PURBOT JRST CPOPJ ANDI B,TYPMSK ; FLUSH MONITORS HRLM C,(P) CAIG B,NUMPRI ; IS A BASIC TYPE JRST @MTYTBS(B) ; TYPE DISPATCH LSH B,1 ; NOW GET PRIMTYPE HRRZ B,@TYPNT ; GET PRIMTYPE ANDI B,SATMSK ; FLUSH DOWN TO SAT CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA JRST @MSATBS(B) ; JUMP OFF SAT TABLE JRST TD.MK GCRET: HLRZ C,(P) ; GET SAVED C CPOPJ: POPJ P, ; TYPE DISPATCH TABLE MTYTBS: OFFSET 0 DUM1: IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] [TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] [TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] [TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] [TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] [TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] [TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] [TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] [TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK] [TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] [TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] [TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] [TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] [TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] [TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] [TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] IRP A,B,[XX] LOC DUM1+A SETZ B .ISTOP TERMIN TERMIN LOC DUM1+NUMPRI+1 OFFSET OFFS ; SAT DISPATCH TABLE MSATBS: OFFSET 0 DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] [STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] [SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] [SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] [SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] [SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] OFFSET OFFS ; ROUTINE TO MARK PAIRS PAIRMK: MOVEI C,(A) PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE CAIGE C,STOSTR JRST BADPTR ; FATAL ERROR HLRE B,(C) ; SKIP IF NOT MARKED JUMPL B,GCRET IORM D,(C) ; MARK IT PUSHJ P,MARK1 ; MARK THE ITEM HRRZ C,(C) ; GET NEXT ELEMENT OF LIST JUMPE C,GCRET CAML C,PURBOT JRST GCRET JRST PAIRM1 ; ROUTINE TO MARK DEFERS DEFMK: HLRE B,(A) JUMPL B,GCRET MOVEI C,(A) IORM D,(C) PUSHJ P,MARK1 JRST GCRET ; ROUTINE TO MARK POSSIBLE DEFERS DEF? DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT LSH B,1 ; COMPUTE THE SAT HRRZ B,@TYPNT ANDI B,SATMSK SKIPL MKTBS(B) ; SKIP IF NOT DEFERED JRST PAIRMK JRST DEFMK ; GO TO DEFMK ; ROUTINE TO MARK VECTORS VECMK: HLRE B,A ; GET LENGTH SUB A,B MOVEI C,1(A) ; POINT TO SECOND DOPE WORD CAIL C,STOSTR ; CHECK FOR IN RANGE CAMLE C,GCSTOP JRST BADPTR HLRE B,(C) JUMPL B,GCRET IORM D,(C) ; MARK IT SUBI C,-1(B) ; GET TO BEGINNING VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD JUMPL B,GCRET ; DONE PUSHJ P,MARK1 ; MARK IT ADDI C,2 ; NEXT ELEMENT JRST VECMK1 ; ROUTINE TO MARK UVECTORS UVMK: HLRE B,A ; GET LENGTH SUB A,B ; A POINTS TO FIRST DOPE WORD MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD CAIL C,STOSTR ; CHECK FOR IN RANGE CAMLE C,GCSTOP JRST BADPTR HLRE F,(C) ; GET LENGTH JUMPL F,GCRET IORM D,(C) ; MARK IT GETYP B,-1(C) ; GET TYPE MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION LSH B,1 HRRZ B,@TYPNT ; GET SAT ANDI B,SATMSK MOVEI B,@MSATBS(B) ; GET JUMP LOCATION CAIN B,GCRET JRST GCRET SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR SUBI F,2 JUMPE F,GCRET PUSH P,F ; SAVE LENGTH PUSH P,E UNLOOP: MOVE B,(P) MOVE A,1(C) ; GET VALUE POINTER PUSHJ P,MARK SOSE -1(P) ; SKIP IF NON-ZERO AOJA C,UNLOOP ; GO BACK AGAIN SUB P,[2,,2] ; CLEAN OFF STACK JRST GCRET ; ROUTINE TO INDICATE A BAD POINTER BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE JRST GCRET ; ROUTINE TO MARK A TPSTACK TPMK: HLRE B,A ; GET LENGTH SUB A,B ; A POINTS TO FIRST DOPE WORD MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD CAIL C,STOSTR ; CHECK FOR IN RANGE CAMLE C,GCSTOP JRST BADPTR HLRE A,(C) JUMPL A,GCRET IORM D,(C) ; MARK IT SUBI C,-1(A) ; GO TO BEGINNING TPLP: HLRE B,(C) ; GET TYPE AND MARKING JUMPL B,GCRET ; EXIT ON FENCE-POST ANDI B,TYPMSK ; FLUSH MONITORS CAIE B,TCBLK ; CHECK FOR FRAME CAIN B,TENTRY JRST MFRAME ; MARK THE FRAME CAIE B,TUBIND ; BINDING BLOCK CAIN B,TBIND JRST MBIND PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT ADDI C,2 ; POINT TO NEXT OBJECT JRST TPLP ; MARK IT ; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION HRRZ A,1(C) ; GET POINTER CAIL A,STOSTR ; SEE IF IN GC SPACE CAMLE A,GCSTOP JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE HRL A,(A) ; GET LENGTH MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] PUSHJ P,MARK MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK MOVEI B,TPDL PUSHJ P,MARK HRROI C,-FSAV+1(C) ; POINT PAST FRAME JRST TPLP ; GO BACK TO START OF LOOP ; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM PUSHJ P,MARK1 ; MARK IT ADDI C,2 ; POINT TO VALUE SLOT PUSHJ P,MARK2 ; MARK THE VALUE ADDI C,2 ; POINT TO DECL AND PREV BINDING MOVEI B,TLIST ; MARK DECL HLRZ A,(C) PUSHJ P,MARK SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING JRST NOTLCI MOVEI B,TLOCI ; GET TYPE PUSHJ P,MARK NOTLCI: ADDI C,2 ; POINT PAST BINDING JRST TPLP PMK: HLRE B,A ; GET LENGTH SUB A,B ; A POINTS TO FIRST DOPE WORD MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD CAIL C,STOSTR ; CHECK FOR IN RANGE CAMLE C,GCSTOP JRST BADPTR IORM D,(C) ; MARK IT JRST GCRET ; ROUTINE TO MARK TB POINTER TBMK: HRRZS A ; CHECK FOR NIL POINTER SKIPN A JRST GCRET MOVE A,TPSAV(A) ; GET A TP POINTER MOVEI B,TTP ; TYPE WORD PUSHJ P,MARK JRST GCRET ; ROUTINE TO MARK AB POINTERS ABMK: HLRE B,A ; GET TO FRAME SUB A,B MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER MOVEI B,TTP ; TYPE WORD PUSHJ P,MARK JRST GCRET ; ROUTINE TO MARK FRAME POINTERS FRMK: HRLZ B,A ; GET THE TIME HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME CAIE B,(F) ; SKIP IF TIMES AGREE JRST GCRET ; IGNORE POINTER IF THEY DONT HRRZ A,(C) ; GET POINTER TO PROCESS SUBI A,1 ; FUDGE FOR VECTOR MARKING MOVEI B,TPVP ; TYPE WORD PUSHJ P,MARK HRRZ A,1(C) ; GET POINTER TO FRAME JRST TBMK ; MARK IT ; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] ARGMK: HLRE B,A ; GET LENGTH SUB A,B ; POINT PAST BLOCK CAIL A,STOSTR CAMLE A,GCSTOP ; SEE IF IN GCSPACE JRST GCRET HRLZ 0,(A) ; GET TYPE ANDI 0,TYPMSK ; FLUSH MONITORS CAIE 0,TENTRY CAIN 0,TCBLK JRST ARGMK1 ; AT FRAME CAIE 0,TINFO ; AT FRAME JRST GCRET ; NOT A LEGAL TYPE GO AWAY HRRZ A,1(A) ; POINTING TO FRAME HRL A,(C) ; GET TIME JRST TBMK ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER HRL A,(C) ; GET TIME JRST TBMK ; ROUTINE TO MARK GLOBAL SLOTS GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL JUMPE B,ATOMK ; NONE GO TO MARK ATOM CAIN B,-1 ; SKIP IF NOT MANIFEST JRST ATOMK PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA MOVEI C,(A) MOVEI A,(B) MOVEI B,TLIST ; TYPE WORD LIST PUSHJ P,MARK ; MARK IT POP P,A JRST ATOMK5 ATOMK: ATOMK5: HLRE B,A SUB A,B ; A POINTS TO DOPE WORD SKIPGE 1(A) ; SKIP IF NOT MARKED JRST GCRET ; EXIT IF MARKED HLRZ B,1(A) SUBI B,3 HRLI B,1(B) MOVEI C,-1(A) SUB C,B ; IN CASE WAS DW IORM D,1(A) ; MARK IT HRRZ A,2(C) ; MARK OBLIST CAMG A,VECBOT JRST NOOBL ; NO IMPURE OBLIST HRLI A,-1 MOVEI B,TOBLS ; MARK THE OBLIST PUSHJ P,MARK NOOBL: HLRZ A,2(C) ; GET NEXT ATOM MOVEI B,TATOM PUSHJ P,MARK HLRZ B,(C) ; GET VALUE SLOT TRZ B,400000 ; TURN OFF MARK BIT SKIPE B ; SEE IF 0 CAIN B,TUNBOUN ; SEE IF UNBOUND JRST GCRET HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER MOVEI B,TVEC ; ASSUME VECTOR SKIPE 0 ; SKIP IF VECTOR MOVEI B,TTP ; IT IS A TP POINTER PUSHJ P,MARK1 ; GO MARK IT JRST GCRET ; ROUTINE TO MARK BYTE AND STRING POINTERS BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] ANDI F,SATMSK ; GET SAT CAIN F,SATOM JRST ATMSET ; IT IS AN ATOM IORM D,(A) ; MARK IT JRST GCRET ATMSET: HLRZ B,(A) ; GET LENGTH TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT MOVNI B,-2(B) ; GENERATE AOBJN POINTER ADDI A,-1(B) ; GET BACK TO BEGINNING HRLI A,(B) ; PUT IN LEFT HALF MOVEI B,TATOM ; MARK AS AN ATOM PUSHJ P,MARK ; GO MARK JRST GCRET ; MARK LOCID GOODIES LOCMK: HRRZ B,(C) ; CHECK FOR TIME JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL HRRZ 0,2(A) ; GET OTHER TIME CAIE 0,(B) ; SAME? JRST GCRET MOVEI B,TTP PUSHJ P,MARK1 JRST GCRET LOCMK1: MOVEI B,TVEC ; GLOBAL PUSHJ P,MARK1 ; MARK VALUE JRST GCRET ; MARK ASSOCIATION BLOCK ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION ADDI A,ASOLNT ; POINT TO DOPE WORD HLRE B,1(A) ; GET SECOND D.W. JUMPL B,GCRET ; MARKED SO LEAVE IORM D,1(A) ; MARK ASSOCATION PUSHJ P,MARK2 ; MARK ITEM MOVEI C,INDIC(C) PUSHJ P,MARK2 MOVEI C,VAL-INDIC(C) PUSHJ P,MARK2 HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN JUMPN A,ASMK ; GO MARK IT JRST GCRET ; MARK OFFSETS OFFSMK: PUSH P,$TLIST HLRZ 0,1(C) ; PICK UP LIST POINTER PUSH P,0 MOVEI C,-1(P) PUSHJ P,MARK2 ; MARK THE LIST SUB P,[2,,2] JRST GCRET ; AND RETURN ; HERE TO MARK TEMPLATE DATA STRUCTURES TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE ANDI B,37777 ; KILL SIGN BIT MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE HRLI E,(E) ADD E,TD.AGC+1 HRRZS C,A ; FLUSH COUNT AND SAVE SKIPL E ; WITHIN BOUNDS FATAL BAD SAT IN AGC SKIPL 1(A) ; SEE IF MARKED JRST GCRET ; IF MARKED LEAVE IORM D,1(A) SKIPE (E) JRST USRAGC SUB E,TD.AGC+1 ; POINT TO LENGTH ADD E,TD.LNT+1 XCT (E) ; RET # OF ELEMENTS IN B HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS PUSH P,[0] ; TEMP USED IF RESTS EXIST PUSH P,D MOVEI B,(B) ; ZAP TO ONLY LENGTH PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE PUSH P,B ; SAVE SUB E,TD.LNT+1 PUSH P,E ; SAVE FOR FINDING OTHER TABLES JUMPE D,TD.MR2 ; NO REPEATING SEQ ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ HLRE E,(E) ; E ==> - LNTH OF TEMPLATE ADDI E,(D) ; E ==> -LENGTH OF REP SEQ MOVNS E HRLM E,-3(P) ; SAVE IT AND BASIC TD.MR2: SKIPG D,-1(P) ; ANY LEFT? JRST TD.MR1 MOVE E,TD.GET+1 ADD E,(P) MOVE E,(E) ; POINTER TO VECTOR IN E MOVEM D,-4(P) ; SAVE ELMENT # SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST SOJA D,TD.MR3 MOVEI 0,(B) ; BASIC LNT TO 0 SUBI 0,(D) ; SEE IF PAST BASIC JUMPGE 0,.-3 ; JUMP IF O.K. MOVSS B ; REP LNT TO RH, BASIC TO LH IDIVI 0,(B) ; A==> -WHICH REPEATER MOVNS A ADD A,-3(P) ; PLUS BASIC ADDI A,1 ; AND FUDGE MOVEM A,-4(P) ; SAVE FOR PUTTER ADDI E,-1(A) ; POINT SOJA D,.+2 TD.MR3: ADDI E,(D) ; POINT TO SLOT XCT (E) ; GET THIS ELEMENT INTO A AND B JFCL ; NO-OP FOR ANY CASE EXCH A,B ; REARRANGE HLRZS B MOVSI D,400000 ; RESET FOR MARK PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED JRST TD.MR2 TD.MR1: SUB P,[5,,5] JRST GCRET USRAGC: XCT (E) ; MARK THE TEMPLATE JRST GCRET ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS ; AND UPDATES PTR TO THE TABLE. GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE HLRE B,A ; GET TO DOPE WORD SUB A,B SKIPGE 1(A) ; SKIP IF NOT MARKED JRST GCRET SUBI A,2 MOVE B,ABOTN ; GET TOP OF ATOM TABLE ADD B,0 ; GET BOTTOM OF ATOM TABLE GCRD1: CAMG A,B ; DON'T SKIP IF DONE JRST GCRET HLRZ C,(A) ; GET MARKING TRZN C,400000 ; SKIP IF MARKED JRST GCRD3 MOVEI E,(A) SUBI A,(C) ; GO BACK ONE ATOM PUSH P,B ; SAVE B PUSH P,A ; SAVE POINTER MOVEI C,-2(E) ; SET UP POINTER MOVEI B,TATOM ; GO TO MARK MOVE A,1(C) PUSHJ P,MARK POP P,A POP P,B JRST GCRD1 GCRD3: SUBI A,(C) ; TO NEXT ATOM JRST GCRD1 ; ROUTINE TO FIX UP CHANNELS CHNFLS: MOVEI 0,N.CHNS-1 MOVEI A,,CHNL1 ; SET UP POINTER CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL JRST CHFL2 ; NO CHANNEL LOOP TO NEXT HLRE C,B ; POINT TO DOPE WORD OF CHANNEL SUBI B,(C) MOVEI F,TCHAN HRLM F,(A) ; PUT TYPE BACK SKIPL 1(B) ; SKIP IF MARKED JRST FLSCH ; FLUSH THE CHANNEL MOVEI F,1 ; MARK THE CHANNEL AS GOOD HRRM F,(A) ; SMASH IT IN CHFL2: ADDI A,2 SOJG 0,CHFL1 POPJ P, ; EXIT FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE JRST CHFL2 ; THIS ROUTINE MARKS ALL THE CHANNELS CHFIX: MOVEI 0,N.CHNS-1 MOVEI A,CHNL1 ; SLOTS DHNFL2: SKIPN 1(A) JRST DHNFL1 PUSH P,0 ; SAVE 0 PUSH P,A ; SAVE A MOVEI C,(A) MOVE A,1(A) MOVEI B,TCHAN PUSHJ P,MARK POP P,A ; RESTORE A POP P,0 ; RESTORE DHNFL1: ADDI A,2 SOJG 0,DHNFL2 POPJ P, ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL ; POINT. FIXSEN: PUSH P,B ; SAVE TIME MOVEI B,[ASCIZ /TIME= /] PUSHJ P,MSGTYP ; PRINT OUT MESSAGE POP P,B ; RESTORE B FMPRI B,(100.0) ; CONVERT TO FIX MULI B,400 TSC B,B ASH C,-163.(B) MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME PUSH P,C IDIVI C,10. ; START COUNTING JUMPLE C,.+2 AOJA A,.-2 POP P,C CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER JRST DOT1 FIXOUT: IDIVI C,10. ; RECOVER NUMBER HRLM D,(P) SKIPE C PUSHJ P,FIXOUT PUSH P,A ; SAVE A CAIN A,2 ; DECIMAL POINT HERE? JRST DOT2 FIX1: HLRZ A,(P)-1 ; GET NUMBER ADDI A,60 ; MAKE IT A CHARACTER PUSHJ P,IMTYO ; OUT IT GOES POP P,A SOJ A, POPJ P, DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 PUSHJ P,IMTYO MOVEI A,"0 PUSHJ P,IMTYO JRST FIXOUT ; CONTINUE DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT PUSHJ P,IMTYO JRST FIX1 ; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE ; RCL LIST, VECTORS ON THE RCLV LIST. SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE SUBI C,1 ; POINT TO FIRST OBJECT SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT JRST ESWEEP ; DONE HLRE A,-1(C) ; SEE IF LIST OR VECTOR TRNE A,UBIT ; SKIP IF LIST JRST VSWEEP ; IT IS A VECTOR JUMPGE A,LSWP1 ; JUMP IF NOT MARKED ANDCAM D,-1(C) ; TURN OFF MARK BIT PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT SUBI C,2 ; SKIP OVER LIST JRST LSWEEP LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS MOVEI E,(C) ; GET ADDRESS LSWP2: SUBI C,2 JRST LSWEEP VSWEEP: HLRE A,(C) ; GET LENGTH JUMPGE A,VSWP1 ; SKIP IF MARKED ANDCAM D,(C) ; TURN OFF MARK BIT PUSHJ P,SWCONS ANDI A,377777 ; GET LENGTH PART SUBI C,(A) ; GO PAST VECTOR JRST LSWEEP VSWP1: ADDI F,(A) ; ADD LENGTH JUMPN E,VSWP2 MOVEI E,(C) ; GET NEW OBJECT LOCATION VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR JRST LSWEEP ESWEEP: SWCONS: JUMPE E,CPOPJ ADDM F,TOTCNT ; HACK TOTCNT CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM MOVEM F,MAXLEN CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG FATAL SWEEP FAILURE CAIN F,2 JRST LCONS SETZM (E) MOVEI 0,(E) SUBI 0,-1(F) SETZM @0 HRLS 0 ADDI 0,1 BLT 0,-2(E) HRRZ 0,RCLV ; GET VECTOR RECYCLE HRRM 0,(E) ; SMASH INTO LINKING SLOT HRRZM E,RCLV ; NEW RECYCLE SLOT HRLM F,(E) MOVSI F,UBIT MOVEM F,-1(E) SETZB E,F POPJ P, ; DONE LCONS: SETZM (E) SUBI E,1 HRRZ 0,RCL ; GET RECYCLE LIST HRRZM 0,(E) ; SMASH IN HRRZM E,RCL SETZB E,F POPJ P, ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC MSGGCT: [ASCIZ /USER CALLED- /] [ASCIZ /FREE STORAGE- /] [ASCIZ /TP-STACK- /] [ASCIZ /TOP-LEVEL LOCALS- /] [ASCIZ /GLOBAL VALUES- /] [ASCIZ /TYPES- /] [ASCIZ /STATIONARY IMPURE STORAGE- /] [ASCIZ /P-STACK /] [ASCIZ /BOTH STACKS BLOWN- /] [ASCIZ /PURE STORAGE- /] [ASCIZ /GC-RCALL- /] ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC GCPAT: SPBLOK 100 EGCPAT: -1 MSGGFT: [ASCIZ /GC-READ /] [ASCIZ /BLOAT /] [ASCIZ /GROW /] [ASCIZ /LIST /] [ASCIZ /VECTOR /] [ASCIZ /SET /] [ASCIZ /SETG /] [ASCIZ /FREEZE /] [ASCIZ /PURE-PAGE LOADER /] [ASCIZ /GC /] [ASCIZ /INTERRUPT-HANDLER /] [ASCIZ /NEWTYPE /] [ASCIZ /PURIFY /] CONSTANTS HERE CONSTANTS OFFSET 0 ZZ==$.+1777 .LOP ANDCM ZZ 1777 ZZ1==.LVAL1 LOC ZZ1 OFFSET OFFS MRKPDL==.-1 ENDGC: OFFSET 0 ZZ2==ENDGC-AGCLD .LOP ZZ2 <,-10.> SLENGC==.LVAL1 .LOP SLENGC <10.> RSLENG==.LVAL1 LOC GCST .LPUR=$. END