X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Famsgc.mid.108;fp=%3Cmdl.int%3E%2Famsgc.mid.108;h=4379f689d62fd90044d16c9f7d286a60b6701066;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//amsgc.mid.108 b//amsgc.mid.108 new file mode 100644 index 0000000..4379f68 --- /dev/null +++ b//amsgc.mid.108 @@ -0,0 +1,886 @@ +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,ASMK] +[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