X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Fagc.mid.131;fp=%3Cmdl.int%3E%2Fagc.mid.131;h=e44c5e7f6cc9590bc4d1bde382881492ef279831;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//agc.mid.131 b//agc.mid.131 new file mode 100644 index 0000000..e44c5e7 --- /dev/null +++ b//agc.mid.131 @@ -0,0 +1,3601 @@ +TITLE AGC MUDDLE GARBAGE COLLECTOR + +;SYSTEM WIDE DEFINITIONS GO HERE + +RELOCATABLE +GCST==$. + + +.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG +.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT +.GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR +.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC +.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC +.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS +.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL +.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI +.GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2 +.GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN +.GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT +; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR + +.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB +.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR + +.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 +.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG +.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET + +.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK +.GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A + +NOPAGS==1 ; NUMBER OF WINDOWS +EOFBIT==1000 +PDLBUF=100 +NTPMAX==20000 ; NORMAL MAX TP SIZE +NTPGOO==4000 ; NORMAL GOOD TP +ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL) +ETPGOO==2000 ; GOOD TP IN EMERGENCY + +.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC) + +GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR +STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT +STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT + + +LOC REALGC +OFFS==AGCLD-$. +GCOFFS=OFFS +OFFSET OFFS + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +TYPNT=AB ;SPECIAL AC USAGE DURING GC +F=TP ;ALSO SPECIAL DURING GC +LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN +FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR + + +; WINDOW AND FRONTIER PAGES + +MAPCH==0 ; MAPPING CHANNEL +.LIST.==400000 +FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP +CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE + + +; INTERNAL GCDUMP ROUTINE +.GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF + +GODUMP: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + MOVE P,GCPDL + PUSH P,AB + PUSHJ P,INFSU1 ; SET UP INFERIORS + +; MARK PHASE + SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES + ; WERE MUNGED + MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR + ; TO COLLECT PURIFIED STRUCTURES + EXCH 0,PURBOT + MOVEM 0,RPURBT ; SAVE THE OLD PURBOT + MOVEI 0,HIBOT + EXCH 0,GCSTOP + MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP + POP P,C ; SET UP PTR TO TYPE/VALUE PAIR + MOVE P,A ; GET NEW PDL PTR + SETOM DUMFLG ; FLAG INDICATING IN DUMPER + MOVE A,TYPVEC+1 + MOVEM A,TYPSAV + ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS + PUSHJ P,MARK2 + MOVEI E,FPAG+6 ; SEND OUT PAIR + PUSH P,C ; SAVE C + MOVE C,A + PUSHJ P,ADWD + POP P,C ; RESTORE C + MOVEI E,FPAG+5 + MOVE C,(C) ; SEND OUT UPDATED PTR + PUSHJ P,ADWD + + MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE + MOVEM 0,TYPTAB + MOVE 0,RPURBT ; RESTORE PURBOT + MOVEM 0,PURBOT + MOVE 0,RGCSTP ; RESTORE GCSTOP + MOVEM 0,GCSTOP + + +; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF +; THEM + + MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR + MOVEI B,0 ; INITIALIZE TYPE COUNT +TYPLP2: HLRE C,(A) ; GET MARKING + JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT + MOVE C,(A) ; GET FIRST WORD + HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL + PUSH P,A + SKIPL FPTR + PUSHJ P,MOVFNT + MOVEM C,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT ; EXTEND THE FRONTIER + POP P,A + MOVE C,1(A) ; OUTPUT SECOND WORD + MOVEM C,FRONT(FPTR) + ADD FPTR,[1,,1] +TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT + ADD A,[2,,2] ; POINT TO NEXT SLOT + JUMPL A,TYPLP2 ; LOOP + +; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN + + HRRZ F,ABOTN + MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER + MOVEM 0,ABOTN ; SAVE IT + PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS + MOVSI D,400000 ; SET UP UNMARK BIT +SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN + MOVEI F,(LPVP) ; GET COPY OF LPVP + HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN + ANDCAM D,(F) ; UNMARK IT + HLRZ C,(F) ; GET LENGTH + HRRZ E,(F) ; POINTER INTO INF + ADD E,ABOTN + SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR + HRLM C,(F) ; ADJUSTED LENGTH + MOVE 0,C ; COPY C FOR TRBLKX + SUBI E,(C) ; ADJUST PTRS FOR SENDOUT + SUBI F,-1(C) + PUSHJ P,TRBLKX ; OUT IT GOES + JRST SPOUT + + +; HERE TO SEND OUT DELIMITER INFORMATION +DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE + JRST CONSTO + SKIPL FPTR ; SEE IF ROOM IN FRONTEIR + PUSHJ P,MOVFNT ; EXTEND FRONTEIR + MOVSI A,.VECT. + MOVEM A,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT + MOVEI A,@BOTNEW ; LENGTH + SUBI A,FPAG + HRLM A,FRONT(FPTR) + ADD FPTR,[1,,1] + + +CONSTO: MOVEI E,FPAG + MOVE C,ABOTN ; START OF ATOMS + SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE + PUSHJ P,ADWD ; OUT IT GOES + MOVEI E,FPAG+1 + MOVEI C,@BOTNEW + SUBI C,FPAG+CONADJ + SKIPE INCORF ; SKIP IF TO CHANNEL + SUBI C,2 ; SUBTRACT FOR DOPE WORDS + PUSHJ P,ADWD + SKIPE INCORF + ADDI C,2 ; RESTORE C TO REAL ABOTN + ADDI C,CONADJ + PUSH P,C + MOVE C,TYPTAB + SUBI C,FPAG+CONADJ + MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMPRI + MOVEI C,NUMPRI + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMSAT + MOVEI C,NUMSAT + PUSHJ P,ADWD + + + +; FINAL CLOSING OF INFERIORS + +DPCLS: PUSH P,PGCNT + PUSHJ P,INFCL1 + POP P,PGCNT + POP P,A ; LENGTH OF CODE + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZB M,R + SETZM DUMFLG + SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER + SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON + PUSH P,A + MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%GBINT + + POP P,A + JRST EGCDUM + + +ERDP: PUSH P,B + PUSHJ P,INFCLS + PUSHJ P,INFCL1 + SETZM GCFLG + SETZM GPURFL ; PURE FLAG + SETZM DUMFLG + SETZM GCDFLG + POP P,A + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + +ERDUMP: PUSH TP,$TATOM + +OFFSET 0 + + PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE + +OFFSET OFFS + + PUSH TP,$TATOM ; PUSH ON PRIMTYPE + PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE + MOVEI A,2 + JRST ERRKIL + +; ALTERNATE ATOM MARKER FOR DUMPER + +DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER + JRST PATOMK + CAILE A,0 ; SEE IF ALREADY MARKED + JRST GCRET + PUSH P,A ; SAVE PTR TO ATOM + HLRE B,A ; POINT TO DOPE WORD + SUB A,B ; TO FIRST DOPE WORD + MOVEI A,1(A) ; TO SECOND + PUSH P,A ; SAVE PTR TO DOPE WORD + HLRZ B,(A) ; GET LENGTH AND MARKING + TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED + JRST DATMK1 + IORM D,(A) ; MARK IT + MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE + ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE + HRRM 0,(A) ; PUT IN RELOCATION + MOVEM 0,ABOTN ; FIXUP TOP OF TABLE + HRRM LPVP,-1(A) ; FIXUP CHAIN + MOVEI LPVP,(A) + MOVE A,-1(P) ; GET POINTER TO ATOM BACK + HRRZ B,2(A) ; GET OBLIST POINTER + JUMPE B,NOOB ; IF ZERO ON NO OBLIST + CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP + MOVE B,(B) + HRLI B,-1 +DATMK3: MOVE A,$TOBLS ; SET UP FOR GET + MOVE C,$TATOM + +OFFSET 0 + MOVE D,IMQUOTE OBLIST + +OFFSET OFFS + + PUSH P,TP ; SAVE FPTR + MOVE TP,MAINPR + MOVE TP,TPSTO+1(TP) ; GET TP + PUSHJ P,IGET + POP P,TP ; RESTORE FPTR + MOVE C,-1(P) ; RECOVER PTR TO ATOM + ADDI C,1 ; SET UP TO MARK OBLIST ATOM + MOVSI D,400000 ; RESTORE MARK WORD + +OFFSET 0 + + CAMN B,MQUOTE ROOT + +OFFSET OFFS + + JRST RTSET + MOVEM B,1(C) + MOVEI B,TATOM + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH IN ITS ID +DATMK1: +NOOB: POP P,A ; GET PTR TO DOPE WORD BACK + HRRZ A,(A) ; RETURN ID + SUB P,[1,,1] ; CLEAN OFF STACK + MOVEM A,(P) + JRST GCRET ; EXIT + +; HERE FOR A ROOT ATOM +RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM + JRST NOOB ; CONTINUE + + +; INTERNAL PURIFY ROUTINE +; SAVE AC's + +IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + +; HERE TO CREATE INFERIORS AND MARK THE ITEM +PURIT1: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE + MOVE C,AB ; ARG PAIR + MOVEM C,SAVRS1 ; SAV PTR TO PAIR + MOVE P,GCPDL + PUSHJ P,INFSUP ; GET INFERIORS + MOVE P,A ; GET NEW PDL PTR + PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX + MOVE C,SAVRS1 ; SET UP FOR MARKING + MOVE A,(C) ; GET TYPE WORD + MOVEM A,SAVRE2 +PURIT3: PUSH P,C + PUSHJ P,MARK2 +PURIT4: POP P,C ; RESTORE C + ADD C,[2,,2] ; TO NEXT ARG + JUMPL C,PURIT3 + MOVEM A,SAVRES ; SAVE UPDATED POINTER + +; FIX UP IMPURE PART OF ATOM CHAIN + + PUSH P,[0] ; FLAG INDICATING NON PURE SCAN + PUSHJ P,FIXATM + SUB P,[1,,1] ; CLEAN OFF STACK + +; NOW TO GET PURE STORAGE + +PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW + SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND + ANDCMI A,1777 + ASH A,-10. ; TO PAGES + SETZ M, + PUSH P,A + PUSHJ P,PGFIND ; FIND THEM + JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC + HRRZ 0,BUFGC ;GET BUFFER PAGE + ASH 0,-10. + MOVEI A,(B) ; GET LOWER PORTION OF PAGES + MOVN C,(P) + SUBM A,C ; GET END PAGE + CAIL 0,(A) ; L? LOWER + CAILE 0,(C) ; G? HIGER + JRST NOREMP ; DON'T GET NEW BUFFER + PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE +NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN + MOVE C,B ; SAVE B + HRL B,A + HRLZS A + ADDI A,1 + MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION + PUSHJ P,%MPIN1 ; MAP IT INTO PURE + ASH C,10. ; TO WORDS + MOVEM C,MAPUP + SUB P,[1,,1] ; CLEAN OFF STACK + +DONMAP: +; RESTORE AC's + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; GET REAL P + PUSH P,LPVP + MOVEI A,@BOTNEW + MOVEM A,NABOTN + + IRP AC,,[M,TP,TB,R,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + MOVE A,INF1 + +; NOW FIX UP POINTERS IN PURE STRUCTURE + MOVE 0,GCSBOT + MOVEM 0,OGCSTP + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,NPRFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; NOW FIX UP POINTERS TO PURIFIED STRUCTURE + + MOVE A,[PUSHJ P,PURFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + + SETZM GCDFLG + SETZM DUMFLG + SETZM GCFLG + + POP P,LPVP ; GET BACK LPVP + MOVE A,INF1 + PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR + PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN + PUSHJ P,FIXATM + +; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED + + MOVE A,INF3 ; GET AOBJN PTR TO PAGES +FIXPMP: HRRZ B,A ; GET A PAGE + IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD + PUSHJ P,PINIT ; SET UP PARAMETER + LSH D,-1 + TDO E,D ; FIX UP WORD + MOVEM E,PMAPB(B) ; SEND IT BACK + AOBJN A,FIXPMP + + SUB P,[1,,1] + MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + +; NOW FIX UP POINTERS IN PURE STRUCTURE + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,PURTFX] + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD + + MOVE A,TYPVEC+1 ; GET TYPE VECTOR + MOVEI B,400000 ; TLOSE==0 +TTFIX: HRRZ D,1(A) ; GET ADDR + HLRE C,1(A) + SUB D,C + HRRM B,(D) ; SMASH IT IN +NOTFIX: ADDI B,1 ; NEXT TYPE + ADD A,[2,,2] + JUMPL A,TTFIX + +; NOW CLOSE UP INFERIORS AND RETURN + +PURCLS: MOVE P,[-2000,,MRKPDL] + PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX + PUSHJ P,INFCLS + + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; RESTORE P + MOVE AB,ABSTO+1(PVP) ; RESTORE R + + MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE + SKIPN NPRFLG + PUSHJ P,%PURIF ; PURIFY + + SETZM GPURFL + JRST EPURIF ; FINISH UP + +NPRFIX: PUSH P,A + PUSH P,B + PUSH P,C + EXCH A,C + PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE + MOVE C,MAPUP ; FIXUP AMOUNT + SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE + CAIE A,SLOCR ; DONT HACK TLOCRS + CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD + JRST LSTFXP + CAIN A,SATOM + JRST ATMFXP + CAIN A,SOFFS + JRST OFFFXP ; FIXUP OFFSETS + HRRZ D,1(B) + JUMPE D,LSTFXP ; SKIP IF NIL + CAMG D,PURTOP ; SEE IF ALREADY PURE + ADDM C,1(B) +LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR + JRST LSTEX1 + HRRZ D,(B) ; GET REST OF LIST + SKIPE D ; SKIP IF POINTS TO NIL + PUSHJ P,RLISTQ + JRST LSTEX1 + CAMG D,PURTOP ; SKIP IF ALREADY PURE + ADDM C,(B) ; FIX UP LIST +LSTEX1: POP P,C + POP P,B ; RESTORE GCHACK AC'S + POP P,A + POPJ P, + +OFFFXP: HLRZ 0,D ; POINT TO LIST + JUMPE 0,LSTFXP ; POINTS TO NIL + CAML 0,PURTOP ; ALREADY PURE? + JRST LSTFXP ; YES + ADD 0,C ; UPDATE THE POINTER + HRLM 0,1(B) ; STUFF IT OUT + JRST LSTFXP ; DONE + +ATMFXP: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO FIRST DOPE WORD + HRRZS D + CAML D,OGCSTP + CAIL D,HIBOT ; SKIP IF IMPURE + JRST LSTFXP + HRRZ 0,1(D) ; GET RELOCATION + SUBI 0,1(D) + ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE + JRST LSTFXP + +; FIXUP OF PURE ATOM POINTERS + +PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER + POPJ P, + HLRE E,D ; GET TO DOPE WORD + SUBM D,E + SKIPL 1(E) ; SKIP IF MARKED + POPJ P, + HRRZ 0,1(E) ; RELATAVIZE PTR + SUBI 0,1(E) + ADD D,0 ; FIX UP PASSED POINTER + SKIPE B ; AND IF APPROPRIATE MUNG POINTER + ADDM 0,1(B) ; FIX UP POINTER + POPJ P, + +PURFIX: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE AC'S FOR GCHACK + EXCH A,C ; GET TYPE IN A + CAIN A,TATOM ; CHECK FOR ATOM + JRST ATPFX + PUSHJ P,SAT + + CAILE A,NUMSAT ; SKIP IF TEMPLATE + JRST TLFX +IFN ITS, JRST @PURDSP(A) +IFE ITS,[ + HRRZ 0,PURDSP(A) + HRLI 0,400000 + JRST @0 +] +PURDSP: + +OFFSET 0 + +DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX], +[S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX] +[SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]] + +OFFSET OFFS + +VECFX: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO D.W. + SKIPL 1(D) ; SKIP IF MARKED + JRST TLFX + HRRZ C,1(D) + SUBI C,1(D) ; CALCULATE RELOCATION + ADD C,MAPUP ; ADJUSTMENT + SUBI C,FPAG + ADDM C,1(B) +TLFX: TLNN B,.LIST. ; SEE IF PAIR + JRST LVPUR ; LEAVE IF NOT + PUSHJ P,RLISTQ + JRST LVPUR + HRRZ D,(B) ; GET CDR + SKIPN D ; SKIP IF NOT ZERO + JRST LVPUR + MOVE D,(D) ; GET CADR + SKIPL D ; SKIP IF MARKED + JRST LVPUR + ADD D,MAPUP + SUBI D,FPAG + HRRM D,(B) ; FIX UP +LVPUR: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +STRFX: MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + SKIPL (A) ; SKIP IF MARKED + JRST TLFX + HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE + SUBI 0,(A) ; RELATAVIZE + ADD 0,MAPUP ; ADJUST + SUBI 0,FPAG + ADDM 0,1(B) ; FIX UP PTR + JRST TLFX + +ATPFX: HLRE C,D + SUBM D,C + SKIPL 1(C) ; SKIP IF MARKED + JRST TLFX + HRRZS C ; SEE IF PURE + CAIL C,HIBOT ; SKIP IF NOT PURE + JRST TLFX + HRRZ 0,1(C) ; GET PTR TO NEW ATOM + SUBI 0,1(C) ; RELATAVIZE + ADD D,0 + JUMPE B,TLFX + ADDM 0,1(B) ; FIX UP + JRST TLFX + +LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL + JRST TLFX + SKIPL (D) ; SKIP IF MARKED + JRST TLFX + HRRZ D,(D) ; GET UPDATED POINTER + ADD D,MAPUP ; ADJUSTMENT + SUBI D,FPAG + HRRM D,1(B) + JRST TLFX + +OFFSFX: HLRZS D ; LIST POINTER + JUMPE D,TLFX ; NIL + SKIPL (D) ; MARKED? + JRST TLFX ; NO + ADD D,MAPUP + SUBI D,FPAG ; ADJUST + HRLM D,1(B) + JRST TLFX ; RETURN + +; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL + +LOSLP1: MOVE A,ABOTN + MOVEM A,PARNEW ; SET UP GC PARAMS + MOVE C,[12.,,6] + JRST PURLOS + +LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED + ADDI A,1777 + ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED + MOVEM A,GCDOWN + MOVE C,[12.,,8.] + JRST PURLOS + +PURLOS: MOVE P,[-2000,,MRKPDL] + PUSH P,GCDOWN + PUSH P,PARNEW + MOVE R,C ; GET A COPY OF A + PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD + PUSHJ P,INFCL2 +PURLS1: POP P,PARNEW + POP P,GCDOWN + MOVE C,R + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZM GCDFLG ; ZERO OUT FLAGS + SETZM DUMFLG + SETZM GPURFL + SETZM GCDANG + + PUSHJ P,AGC ; GARBAGE COLLECT + JRST PURIT1 ; TRY AGAIN + +; PURIFIER ATOM MARKER + +PATOMK: HRRZ 0,A + CAMG 0,PARBOT + JRST GCRET ; DONE IF FROZEN + HLRE B,A ; GET TO D.W. + SUB A,B + SKIPG 1(A) ; SKIP IF NOT MARKED + JRST GCRET + HLRZ B,1(A) + IORM D,1(A) ; MARK THE ATOM + ADDM B,ABOTN + HRRM LPVP,(A) ; LINK ONTO CHAIN + MOVEI LPVP,1(A) + JRST GCRET ; EXIT + + +.GLOBAL %LDRDO,%MPRDO + +; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES. + +; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE +; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING + +; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD +; INFERIOR IN READ/EXEC MODE + +REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF + SKIPA +PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF + MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS + ASH A,-10. ; CONVERT TO PAGES + MOVEI C,HIBOT ; GET ENDING PAGE + ASH C,-10. ; CONVERT TO PAGES + PUSH P,A ; SAVE PAGE POINTER + PUSH P,C ; SAVE END OF PURENESS POINTER +PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK + JRST PRODON ; DONE MAPPING PAGES + PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE + JRST NOTPUR ; IT IS NOT + MOVE A,-1(P) ; GET PAGE TO MAP + XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE +NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD + JRST PROLOP ; LOOP BACK +PRODON: SUB P,[3,,3] ; CLEAN OFF STACK + POPJ P, ; EXIT + + + +.GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1 +.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF +INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP + SKIPA +INFSUP: PUSH P,[0] + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS + SETOM GCDFLG + SETOM GCFLG + HLLZS SQUPNT + HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT + HRLI TYPNT,B + MOVEI A,STOSTR + ANDCMI A,1777 ; TO PAGE BOUNDRY + SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK + ASH A,-10. ; TO PAGES + HRLZS A + MOVEI B,STOSTR ; GET START OF MAPPING + ASH B,-10. + ADDI A,(B) + MOVEM A,INF1 + PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE + SKIPGE (P) ; IF < 0 GC-DUMP CALL + PUSHJ P,PROPUR ; PROTECT PURE PAGES + SUB P,[1,,1] ; CLEAN OFF PSTACK + PUSHJ P,%CLSJB ; CLOSE INFERIOR + + MOVSI D,400000 ; CREATE MARK WORD + SETZB LPVP,ABOTN ; ZERO ATOM COUNTER + MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE + HRRM A,BOTNEW + SETZM WNDBOT + SETZM WNDTOP + HRRZM A,FNTBOT + ADDI A,2000 ; WNDTOP + MOVEI A,1 ; TO PAGES + PUSHJ P,%GCJB1 ; CREATE THE JOB + MOVSI FPTR,-2000 + MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVE 0,A ; COPY TO 0 + ASH 0,-10. ; TO PAGES + SUB A,HITOP ; SUBTRACT TOP OF CORE + ASH A,-10. + HRLZS A + ADD A,0 + MOVEM A,INF2 + PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER + PUSHJ P,%OPGFX + +; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS + + MOVE A,[-2000,,MRKPDL] + POPJ P, + +; ROUTINE TO CLOSE GC's INFERIOR + + +INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%CLSMP + POPJ P, + +; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP + +INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES +INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER + PUSH P,INF2 + MOVE B,A ; SATIFY MUDITS + PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR + POP P,INF2 ; RESTOR INF2 PARAMETER + POPJ P, + +INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES + SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED + PUSHJ P,REPURE ; REPURIFY MUNGED PAGES + JRST INFCL3 + + + +; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE +; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN +; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST +; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT +; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE). + +TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE + JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER + CAIN B,TTYPEC ; SKIP IF NOT TYPE-C + JRST TYPCHK ; GO TO HACK TYPE-C + CAIE B,TTYPEW ; SKIP IF TYPE-W + POPJ P, + PUSH P,B + HLRZ B,A ; GET TYPE + JRST TYPHKA ; GO TO TYPE-HACKER +TYPCHK: PUSH P,B ; SAVE TYPE-WORD + HRRZ B,A + JRST TYPHKA + +; GENERAL TYPE-HACKER FOR GC-DUMP + +TYPHKR: PUSH P,B ; SAVE AC'S +TYPHKA: PUSH P,A + PUSH P,C + LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR + MOVEI C,(TYPNT) ; GET TO SLOT + ADDI C,(B) + SKIPGE (C) + JRST EXTYP + IORM D,(C) ; MARK THE SLOT + MOVEI B,TATOM ; NOW MARK THE ATOM SLOT + PUSHJ P,MARK1 ; MARK IT + HRRM A,1(C) ; SMASH IN ID + HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE + HRRZ B,(C) ; GET SAT + ANDI B,SATMSK ; GET RID OF MAGIC BITS + HRRM B,(C) ; SMASH SAT BACK IN + CAIG B,NUMSAT ; SKIP IF TEMPLATE + JRST EXTYP + MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR + ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS + HRLI 0,NUMPRI*2 + HLLZS 0 ; MAKE SURE ONLY LEFT HALF + ADD A,0 +TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT + CAMN E,B ; SKIP IF NOT EQUAL + JRST TYPHK2 ; GOT IT + ADDI A,2 ; TO NEXT + JRST TYPHK1 +TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT + MOVE C,A ; COPY A + MOVEI B,TATOM ; SET UP FOR MARK + MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE + SKIPL (C) ; DON'T MARK IF ALREADY MARKED + PUSHJ P,MARK + POP P,C ; RESTORE C + HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE +EXTYP: POP P,C ; RESTORE AC'S + POP P,A + POP P,B + POPJ P, ; EXIT + + +; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER +RLISTQ: PUSH P,A + GETYP A,(B) ; GET TYPE + PUSHJ P,SAT ; GET SAT + CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE + SKIPL MKTBS(A) + AOS -1(P) ; SKIP IF NOT DEFFERED + POP P,A + POPJ P, ; EXIT + + +; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) + +GCDISP: + +OFFSET 0 + +DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP] +[STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK] +[SFRAME,ERDP],[SBYTE,],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP] +[SLOCID,ERDP],[SCHSTR,],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP] +[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ERDP] +[SLOCB,],[SLOCR,LOCRDP],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPRF: PUSH P,A + PUSH P,LPVP + PUSH TP,$TATOM + HLRZ C,(A) ; GET LENGTH + TRZ C,400000 ; TURN OF 400000 BIT + SUBI A,-1(C) ; POINT TO START OF ATOM + MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER + HRL A,C + PUSH TP,A + MOVE C,A + MOVEI 0,(C) + PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + PUSHJ P,IMPURX + POP P,AB + POP P,LPVP ; RESTORE A + POP P,A + POPJ P, + +FIXATM: PUSH P,[0] +FIXTM5: JUMPE LPVP,FIXTM4 + MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD + HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN + SKIPE -2(P) ; SEE IF PURE SCAN + JRST FIXTM2 + CAIL B,HIBOT + JRST FIXTM3 +FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN + JRST FIXTM1 + HLRZ A,(B) + TRZ A,400000 ; GET RID OF MARK BIT + MOVE D,A ; GET A COPY OF LENGTH + SKIPE -2(P) + JRST PFATM + PUSHJ P,CAFREE ; GET STORAGE + SKIPE GCDANG ; SEE IF WON + JRST LOSLP1 ; GO TO CAUSE GC + JRST FIXT10 +PFATM: PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + SETZM GPURFL + PUSHJ P,CAFREE + SETOM GPURFL + POP P,AB +FIXT10: SUBM D,ABOTN + MOVNS ABOTN + SUBI B,-1(D) ; POINT TO START OF ATOM + HRLZ C,B ; SET UP FOR BLT + HRRI C,(A) + ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD + BLT C,(A) + HLLZS -1(A) + HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE + ADDI B,-1(D) ; B POINTS TO SECOND D.W. + HRRM A,(B) ; PUT IN RELOCATION + MOVSI D,400000 ; UNMARK ATOM + ANDCAM D,(A) + CAIL B,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPRF + JRST FIXTM5 ; CONTINE FIXUP + +FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN + POPJ P, ; EXIT + +FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION + MOVSI D,400000 + ANDCAM D,(B) ; CLEAR MARK BIT + JRST FIXTM5 + +FIXTM3: MOVE 0,(P) + HRRM 0,-1(B) + MOVEM B,(P) ; FIX UP CHAIN + JRST FIXTM5 + + + +IAGC": + +;SET FLAG FOR INTERRUPT HANDLER + SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR + EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES + PUSH P,B + PUSH P,A + PUSH P,C ; SAVE C + +; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING + + + + MOVE A,NOWFRE + ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL + SUB A,FRETOP + MOVEM A,NOWFRE + MOVE A,NOWP ; ADJUSTMENTS FOR STACKS + SUB A,CURP + MOVEM A,NOWP + MOVE A,NOWTP + SUB A,CURTP + MOVEM A,NOWTP + + MOVEI B,[ASCIZ /GIN /] + SKIPE GCMONF ; MONITORING + PUSHJ P,MSGTYP +NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR + MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON + ADDI B,1 + MOVEM B,GCNO(C) + MOVEM C,GCCAUS ; SAVE CAUSE OF GC + SKIPN GCMONF ; MONITORING + 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 ; SAVE CALLER OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON3 + MOVE B,MSGGFT(C) + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] ; POP OFF C + POP P,A + POP P,B + EXCH P,GCPDL + JRST .+1 +IAAGC: + HLLZS SQUPNT ; FLUSH SQUOZE TABLE + SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION +INITGC: SETOM GCFLG + SETZM RCLV + +;SAVE AC'S + EXCH PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 + MOVEM 0,PVPSTO+1(PVP) + MOVEM PVP,PVSTOR+1 + MOVE D,DSTORE + MOVEM D,DSTO(PVP) + JSP E,CKPUR ; CHECK FOR PURE RSUBR + + +;SET UP E TO POINT TO TYPE VECTOR + GETYP E,TYPVEC + CAIE E,TVEC + JRST AGCE1 + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B + +CHPDL: MOVE D,P ; SAVE FOR LATER +CORGET: MOVE P,[-2000,,MRKPDL] + +;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK + + MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS + PUSHJ P,FRMUNG ;AND MUNG IT + MOVE A,TP ;THEN TEMPORARY PDL + PUSHJ P,PDLCHK + MOVE PVP,PVSTOR+1 + MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK + PUSHJ P,PDLCHP + + ; FIRST CREATE INFERIOR TO HOLD NEW PAGES + +INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW + ADD A,PARNEW + ADDI A,1777 + ANDCMI A,1777 ; EVEN PAGE BOUNDARY + HRRM A,BOTNEW ; INTO POINTER WORD + HRRZM A,FNTBOT + SETZM WNDBOT + SETZM WNDTOP + MOVEM A,NPARBO + HRRZ A,BOTNEW ; GET PAGE TO START INF AT + ASH A,-10. ; TO PAGES + MOVEI R,(A) ; COPY A + PUSHJ P,%GCJOB ; GET PAGE HOLDER + MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER + MOVE A,WNDBOT + ADDI A,2000 ; FIND WNDTOP + MOVEM A,WNDTOP + +;MARK PHASE: MARK ALL LISTS AND VECTORS +;POINTED TO WITH ONE BIT IN SIGN BIT +;START AT TRANSFER VECTOR +NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE + MOVEM A,GCGBSP + MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC + MOVEM A,GCASOV + MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE + MOVEM A,GCNOD + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG + MOVEM A,PURSVT + MOVE A,HASHTB+1 + MOVEM A,GCHSHT + + SETZ LPVP, ;CLEAR NUMBER OF PAIRS + MOVE 0,NGCS ; SEE IF NEED HAIR + SOSGE GCHAIR + MOVEM 0,GCHAIR ; RESUME COUNTING + MOVSI D,400000 ;SIGN BIT FOR MARKING + MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW + PUSHJ P,PRMRK ; PRE-MARK + MOVE A,GLOBSP+1 + PUSHJ P,PRMRK + MOVE A,HASHTB+1 + PUSHJ P,PRMRK +OFFSET 0 + + MOVE A,IMQUOTE THIS-PROCESS + +OFFSET OFFS + + MOVEM A,GCATM + +; HAIR TO DO AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; 1ST SLOT + + SKIPE 1(A) ; NOW A CHANNEL? + SETZM (A) ; DON'T MARK AS CHANNELS + ADDI A,2 + SOJG 0,.-3 + + MOVEI C,PVSTOR + MOVEI B,TPVP + MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEI C,MAINPR-1 + MOVEI B,TPVP + MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEM A,MAINPR ; ADJUST PTR + +; ASSOCIATION AND VALUE FLUSHING PHASE + + SKIPN GCHAIR ; ONLY IF HAIR + PUSHJ P,VALFLS + + SKIPN GCHAIR + PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE + + SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW + PUSHJ P,CHNFLS + + PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS + PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS + + + MOVE A,NPARBO ; UPDATE GCSBOT + MOVEM A,GCSBOT + MOVE A,PURSVT + PUSH P,PURVEC+1 + MOVEM A,PURVEC+1 ; RESTORE PURVEC + PUSHJ P,CORADJ ; ADJUST CORE SIZE + POP P,PURVEC+1 + + + + ; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE + +NOMAP1: MOVEI A,@BOTNEW + ADDI A,1777 ; TO PAGE BOUNDRY + ANDCMI A,1777 + MOVE B,A +DOMAP: ASH B,-10. ; TO PAGES + MOVE A,PARBOT + MOVEI C,(A) ; COMPUTE HIS TOP + ASH C,-10. + ASH A,-10. + SUBM A,B ; B==> - # OF PAGES + HRLI A,(B) ; AOBJN TO SOURCE AND DEST + MOVE B,A ; IN CASE OF FUNNY + HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES + PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE + JRST GARZER + + ; CORE ADJUSTMENT PHASE + +CORADJ: MOVE A,PURTOP + SUB A,CURPLN ; ADJUST FOR RSUBR + ANDCMI A,1777 ; ROUND DOWN + MOVEM A,RPTOP + MOVEI A,@BOTNEW ; NEW GCSTOP + ADDI A,1777 ; GCPDL AND ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE + CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN + FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE + CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT + JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE + PUSHJ P,MAPOUT ; GET THE CORE + FATAL AGC--PAGES NOT AVAILABLE + +; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS +; FIRST LETS SEE IF WE HAVE TO CORE DOWN. +; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED + +CORAD0: SKIPN B,GCDOWN ; CORE DOWN? + JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS + ADDI A,(B) ; AMOUNT+ONE FREE BLOCK + CAMGE A,RPTOP ; CAN WE WIN + JRST CORAD3 ; POSSIBLY + +; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR +CORAD2: SETOM GCDANG ; INDICATE LOSSAGE + +; CALCULATE PARAMETERS BEFORE LEAVING +CORAD6: MOVE A,PURSVT ; GET PURE TABLE + PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED + MOVEI A,@BOTNEW ; GCSTOP + MOVEM A,GCSTOP + MOVE A,CORTOP ; ADJUST CORE IMAGE + ASH A,-10. ; TO PAGES +TRYPCO: PUSHJ P,P.CORE + FATAL AGC--CORE SCREW UP + MOVE A,CORTOP ; GET IT BACK + ANDCMI A,1777 + MOVEM A,FRETOP + MOVEM A,RFRETP + POPJ P, + +; TRIES TO SATISFY REQUEST FOR CORE +CORAD1: MOVEM A,CORTOP + MOVEI A,@BOTNEW + ADD A,GETNUM ; ADD MINIMUM CORE NEEDED + ADDI A,1777 ; ONE BLOCK+ROUND + ANDCMI A,1777 ; TO BLOCK BOUNDRY + CAMLE A,RPTOP ; CAN WE WIN + JRST CORAD2 ; LOSE + CAMGE A,PURBOT + JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE + PUSHJ P,MAPOUT + JRST CORAD2 ; LOSS + +; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE +CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE + MOVE B,RPTOP ; GET REAL PURTOP + SUB B,PURMIN ; KEEP PURMIN + CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH + MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT + MOVEM B,RPTOP ; FOOL CORE HACKING + ADD A,FREMIN + ANDCMI A,1777 ; TO PAGE BOUNDRY + CAMGE A,RPTOP ; DO WE WIN TOTALLY + JRST CORAD4 + MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE + PUSHJ P,MAPOUT + JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING +CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE + JRST CORAD8 + PUSHJ P,MAPOUT ; GET IT + JRST CORAD6 +CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER + JRST CORAD6 ; WIN TOTALLY + +; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE + +CORAD3: ADD A,FREMIN + ANDCMI A,1777 + CAMGE A,PURBOT ; CAN WE WIN + JRST CORAD9 + MOVE A,RPTOP +CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST + JRST CORAD4 ; GO CHECK ALLOCATION + +MAPOUT: PUSH P,A ; SAVE A + SUB A,P.TOP ; AMOUNT TO GET + ADDI A,1777 ; ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + ASH A,-PGSZ ; TO PAGES + PUSHJ P,GETPAG ; GET THEN + JRST MAPLOS ; LOSSAGE + AOS -1(P) ; INDICATE WINNAGE +MAPLOS: POP P,A + POPJ P, + + + ;GARBAGE ZEROING PHASE +GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE + MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1 + CAIL A,(B) + JRST GARZR1 + CLEARM (A) ;ZERO THE FIRST WORD + CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP) + JRST GARZR1 ; DON'T BLT +IFE ITS,[ + MOVEI B,777(A) + ANDCMI B,777 +] + HRLS A + ADDI A,1 ;MAKE A A BLT POINTER + BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA +IFE ITS,[ + +; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE) + + MOVE D,PURBOT + ASH D,-PGSZ + ASH B,-PGSZ + MOVNI A,1 + MOVEI C,0 + HRLI B,400000 + +GARZR2: CAIG D,(B) + JRST GARZR1 + + PMAP + AOJA B,GARZR2 +] + + +; NOW REHASH THE ASSOCIATIONS BASED ON VALUES +GARZR1: PUSHJ P,REHASH + + + ;RESTORE AC'S +TRYCOX: SKIPN GCMONF + JRST NOMONO + MOVEI B,[ASCIZ /GOUT /] + PUSHJ P,MSGTYP +NOMONO: MOVE PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + SKIPN DSTORE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; CLOSING ROUTINE FOR G-C + PUSH P,A ; SAVE AC'C + PUSH P,B + PUSH P,C + PUSH P,D + + MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS + SUB A,GCSTOP + ADDM A,NOWFRE + PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS + MOVE A,CURTP + ADDM A,NOWTP + MOVE A,CURP + ADDM A,NOWP + + PUSHJ P,CTIME + FSBR B,GCTIM ; GET TIME ELAPSED + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + SKIPN GCMONF ; SEE IF MONITORING + JRST GCCONT + PUSHJ P,FIXSEN ; OUTPUT TIME + MOVEI A,15 ; OUTPUT C/R LINE-FEED + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE + ; SHRINKAGE FOR EXTRA ROOM + SKIPE GCDANG + MOVE C,[ETPGOO,,ETPMAX] + HLRZM C,TPGOOD + HRRZM C,TPMAX + POP P,D ; RESTORE AC'C + POP P,C + POP P,B + POP P,A + MOVE A,GCDANG + JUMPE A,AGCWIN ; IF ZERO THE GC WORKED + SKIPN GCHAIR ; SEE IF HAIRY GC + JRST BTEST +REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC + MOVEM A,GCHAIR + SETZM GCDANG + MOVE C,[11,,10.] ; REASON FOR GC + JRST IAGC + +BTEST: SKIPE INBLOT + JRST AGCWIN + FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS + JRST REAGCX + +AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL + SETZM GETNUM ;ALSO CLEAR THIS + SETZM INBLOT + SETZM GCFLG + + SETZM PGROW ; CLEAR GROWTH + SETZM TPGROW + SETOM GCHAPN ; INDICATE A GC HAS HAPPENED + SETOM GCHPN + SETOM INTFLG ; AND REQUEST AN INTERRUPT + SETZM GCDOWN + PUSHJ P,RBLDM + JUMPE R,FINAGC + JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT + SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JRST FINAGC + + FATAL AGC--RUNNING RSUBR WENT AWAY + +AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR + + ; 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 + + + ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING + +PDLCHK: JUMPGE A,CPOPJ + HLRE B,A ;GET NEGATIVE COUNT + MOVE C,A ;SAVE A COPY OF PDL POINTER + SUBI A,-1(B) ;LOCATE DOPE WORD PAIR + HRRZS A ; ISOLATE POINTER + CAME A,TPGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOFENC + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOFENC + MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS + HRRI D,2(C) + BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS + + +NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE + CAMG B,TPMIN + JRST MUNGTP ;TOO BIG OR TOO SMALL + POPJ P, + +MUNGTP: SUB B,TPGOOD ;FIND DELTA TP +MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED + TRNE C,777000 ;SKIP IF NOT + POPJ P, ;ASSUME GROWTH GIVEN WILL WIN + + ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS + JUMPLE B,MUNGT1 + CAILE B,377 ; SKIP IF BELOW MAX + MOVEI B,377 ; ELSE USE MAX + TRO B,400 ;TURN ON SHRINK BIT + JRST MUNGT2 +MUNGT1: MOVMS B + ANDI B,377 +MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD + POPJ P, + +; CHECK UNMARKED STACK (NO NEED TO FENCE POST) + +PDLCHP: HLRE B,A ;-LENGTH TO B + MOVE C,A + SUBI A,-1(B) ;POINT TO DOPE WORD + HRRZS A ;ISOLATE POINTER + CAME A,PGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOPF + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOPF + MOVSI D,1(C) + HRRI D,2(C) + BLT D,-2(A) + +NOPF: CAMG B,PMAX ;TOO BIG? + CAMG B,PMIN ;OR TOO LITTLE + JRST .+2 ;YES, MUNG IT + POPJ P, + SUB B,PGOOD + JRST MUNG3 + + +; ROUTINE TO PRE MARK SPECIAL HACKS + +PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR + POPJ P, +PRMRK2: HLRE B,A + SUBI A,(B) ;POINT TO DOPE WORD + HLRZ F,1(A) ; GET LNTH + LDB 0,[111100,,(A)] ; GET GROWTHS + TRZE 0,400 ; SIGN HACK + MOVNS 0 + ASH 0,6 ; TO WORDS + ADD F,0 + LDB 0,[001100,,(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD F,0 + PUSHJ P,ALLOGC + HRRM 0,1(A) ; NEW RELOCATION FIELD + IORM D,1(A) ;AND MARK + POPJ P, + + + ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS +; A/ GOODIE TO MARK FROM +; B/ TYPE OF A (IN RH) +; C/ TYPE,DATUM PAIR POINTER + +MARK2A: +MARK2: HLRZ B,(C) ;GET TYPE +MARK1: MOVE A,1(C) ;GET GOODIE +MARK: SKIPN DUMFLG + JUMPE A,CPOPJ ; NEVER MARK 0 + MOVEI 0,1(A) + CAIL 0,@PURBOT + JRST GCRETD +MARCON: PUSH P,A + HRLM C,-1(P) ;AND POINTER TO IT + ANDI B,TYPMSK ; FLUSH MONITORS + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK SOME TYPES + LSH B,1 ;TIMES 2 TO GET SAT + HRRZ B,@TYPNT ;GET SAT + ANDI B,SATMSK + JUMPE A,GCRET + CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST TD.MRK + SKIPN GCDFLG +IFN ITS,[ + JRST @MKTBS(B) ;AND GO MARK + JRST @GCDISP(B) ; DISPATCH FOR DUMPERS +] +IFE ITS,[ + SKIPA E,MKTBS(B) + MOVE E,GCDISP(B) + HRLI E,-1 + JRST (E) +] +; HERE TO MARK A POSSIBLE DEFER POINTER + +DEFQMK: GETYP B,(A) ; GET ITS TYPE + LSH B,1 + HRRZ B,@TYPNT + ANDI B,SATMSK ; AND TO SAT + SKIPGE MKTBS(B) + +;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER + +DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG + +;HERE TO MARK LIST ELEMENTS + +PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT + PUSH P,[0] ; WILL HOLD BACK PNTR + MOVEI C,(A) ; POINT TO LIST +PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS + CAMGE C,PARBOT + FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE + SKIPGE B,(C) ;SKIP IF NOT MARKED + JRST RETNEW ;ALREADY MARKED, RETURN + IORM D,(C) ;MARK IT + SKIPL FPTR ; SEE IF IN FRONTEIR + PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR + MOVEM B,FRONT(FPTR) + MOVE 0,1(C) ; AND 2D + AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR + PUSHJ P,MOVFNT ; EXPAND FRONTEIR + MOVEM 0,FRONT(FPTR) + ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER + + +PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR + SUBI A,2 + HRRM A,(C) ; LEAVE A POINTER TO NEW HOME + HRRZ E,(P) ; GET BACK POINTER + JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP + MOVSI 0,(HRRM) ; INS FOR CLOBBER + PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE +PAIRM4: MOVEM A,(P) ; NEW BACK POINTER + JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER + HRLM B,(P) ; SAVE OLD CDR + PUSHJ P,MARK2 ;MARK THIS DATUM + HRRZ E,(P) ; SMASH CAR IN CASE CHANGED + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF + HLRZ C,(P) ;GET CDR OF LIST + CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK) + JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT +GCRETP: SUB P,[1,,1] + +GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT + HLRZ C,-1(P) ;RESTORE C + POP P,A + POPJ P, ;AND RETURN TO CALLER + +GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS + CAIN B,TLOCR ; SEE IF A LOCR + JRST MARCON + SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER + POPJ P, + CAIE B,TATOM ; WE MARK PURE ATOMS + CAIN B,TCHSTR ; AND STRINGS + JRST MARCON + POPJ P, + +;HERE TO MARK DEFERRED POINTER + +DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK + PUSH P,1(C) + MOVEI C,-1(P) ; USE AS NEW DATUM + PUSHJ P,MARK2 ;MARK THE DATUM + HRRZ E,-2(P) ; GET POINTER IN INF CORE + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF ; AND CLOBBER + HRRZ E,-2(P) + MOVE A,-1(P) + MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF + PUSHJ P,SMINF + SUB P,[3,,3] + JRST GCRET ;AND RETURN + + +PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN + JRST PAIRM4 + +RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN + HRRZ E,(P) ; BACK POINTER + JUMPE E,RETNW1 ; NONE + MOVSI 0,(HRRM) + PUSHJ P,SMINF + JRST GCRETP + +RETNW1: MOVEM A,-1(P) + JRST GCRETP + +; ROUTINE TO EXPAND THE FRONTEIR + +MOVFNT: PUSH P,B ; SAVE REG B + HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW + ADDI A,2000 ; MOVE IT UP + HRRM A,BOTNEW + HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR + MOVEI B,FRNP + ASH A,-10. ; TO PAGES + PUSHJ P,%GETIP + PUSHJ P,%SHWND ; SHARE THE PAGE + MOVSI FPTR,-2000 ; FIX UP FPTR + POP P,B + POPJ P, + + +; ROUTINE TO SMASH INFERIORS PPAGES +; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE + +SMINF: CAMGE E,FNTBOT + JRST SMINF1 ; NOT IN FRONTEIR + SUB E,FNTBOT ; ADJUST POINTER + IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION + XCT 0 ; XCT IT + POPJ P, ; EXIT +SMINF1: CAML E,WNDBOT + CAML E,WNDTOP ; SEE IF IN WINDOW + JRST SMINF2 +SMINF3: SUB E,WNDBOT ; FIX UP + IOR 0,[0 A,WIND(E)] ; FIX INS + XCT 0 + POPJ P, +SMINF2: PUSH P,A ; SAVE E + PUSH P,B ; SAVE B + HRRZ A,E ; E SOMETIMES HAS STUFF IN LH + ASH A,-10. + MOVEI B,WNDP ; WINDOW PAGE + PUSHJ P,%SHWND ; SHARE IT + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE ACS + POP P,A + JRST SMINF3 ; FIX UP INF + + + + ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE + +TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG +VECTMK: TLZ TYPNT,400000 + MOVEI 0,@BOTNEW ; POINTER TO INF + PUSH P,0 + MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR + HLRE B,A ;GET -LNTH + SUB A,B ;LOCATE DOPE WORD + MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;LOSE, COMPLAIN + + HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK + JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK + CAME A,PGROW ;IS THIS THE BLOWN P + CAMN A,TPGROW ;IS THIS THE GROWING PDL + JRST NOBUFR ;YES, DONT ADD BUFFER + ADDI A,PDLBUF ;POINT TO REAL DOPE WORD + MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER + ADD 0,1(C) + MOVEM 0,-1(P) ; FIXUP RET'D PNTR + +NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD + JUMPL B,EXVECT ; MARKED, LEAVE + LDB B,[111100,,-1(A)] ; GET TOP GROWTH + TRZE B,400 ; HACK SIGN BIT + MOVNS B + ASH B,6 ; CONVERT TO WORDS + PUSH P,B ; SAVE TOP GROWTH + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSH P,0 ; SAVE BOTTOM GROWTH + ADD B,0 ;TOTAL GROWTH TO B +VECOK: HLRE E,(A) ;GET LENGTH AND MARKING + MOVEI F,(E) ;SAVE A COPY + ADD F,B ;ADD GROWTH + SUBI E,2 ;- DOPE WORD LENGTH + IORM D,(A) ;MAKE SURE NOW MARKED + PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF + HRRM 0,(A) +VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE + PUSH P,A ; SAVE POINTER TO DOPE WORD + SKIPGE B,-1(A) ;SKIP IF UNIFORM + TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL + JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR + +GENRAL: HLRZ 0,B ;CHECK FOR PSTACK + TRZ 0,.VECT. + JUMPE 0,NOTGEN ;IT ISN'T GENERAL + JUMPL TYPNT,TPMK1 ; JUMP IF TP + MOVEI C,(A) + SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR + + ; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR +VECTM2: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST) + MOVE A,1(C) ;DATUM TO A + + +VECTM3: PUSHJ P,MARK ;MARK DATUM + MOVEM A,1(C) ; IN CASE WAS FIXED +VECTM4: ADDI C,2 + JRST VECTM2 + +UMOVEC: POP P,A +MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH + HRRZ E,-1(P) ; GET POINTER INTO INF + SKIPN C ; SKIP IF NO BOTTOM GROWTH + JRST MOVEC3 + JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE + ADD E,C ; GROW IT + JRST MOVEC3 ; CONTINUE + HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE +MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF + PUSHJ P,TRBLKV ; SEND VECTOR INTO INF +TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE + JRST TGROT1 + MOVE C,DOPSV1 ; RESTORE DOPE WORD + SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH + MOVEM C,-1(A) +TGROT1: POP P,C ; IS THERE TOP GROWH + SKIPN C ; SEE IF ANY GROWTH + JRST DOPEAD + SUBI E,2 + SKIPG C + JRST OUTDOP + PUSH P,C ; SAVE C + SETZ C, ; ZERO C + PUSHJ P,ADWD + ADDI E,1 + SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE + PUSHJ P,ADWD + POP P,C + ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH +OUTDOP: PUSHJ P,DOPOUT +DOPEAD: +EXVECT: HLRZ B,(P) + SUB P,[1,,1] ; GET RID OF FPTR + PUSHJ P,RELATE ; RELATIVIZE + TRNN B,400000 ; WAS THIS A STACK + JRST GCRET + MOVSI 0,PDLBUF ; FIX UP STACK PTR + ADDM 0,(P) + JRST GCRET ; EXIT + +VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE + HLLZ 0,(C) ;GET TYPE + MOVEI B,TILLEG ;GET ILLEGAL TYPE + HRLM B,(C) + MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE + JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR + +CCRET: CLEARM 1(C) ;CLOBBER THE DATUM + JRST GCRET + + +; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN +; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL. + +TPMK1: +TPMK2: POP P,A + POP P,C + HRRZ E,-1(P) ; FIX UP PARAMS + ADDI E,(C) + PUSH P,A ; REPUSH A + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + MOVE C,-1(P) ; ADJUST FOR GROWTH + SUB B,C + HRLZS C + PUSH P,C + PUSH P,B + PUSH P,E + PUSH P,[0] +TPMK3: HLRZ E,(A) ; GET LENGTH + TRZ E,400000 ; GET RID OF MARK BIT + SUBI A,-1(E) ;POINT TO FIRST ELEMENT + MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C +TPMK4: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST) + HRRZ A,(C) ;DATUM TO A + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK + CAIN B,TENTRY ;IS THIS A STACK FRAME + JRST MFRAME ;YES, MARK IT + CAIE B,TUBIND ; BIND + CAIN B,TBIND ;OR A BINDING BLOCK + JRST MBIND + CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS + CAIN B,TUNWIN + SKIPA ; FIX UP SP-CHAIN + CAIN B,TSKIP ; OTHER BINDING HACK + PUSHJ P,FIXBND + + +TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN + PUSHJ P,MARK1 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE +TPMK6: ADDI C,2 + JRST TPMK4 + +MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME + HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION + HRRZ A,1(C) ; GET IT + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC + PUSHJ P,MARK ; AND MARK IT +MFRAM1: HLL A,1(C) + PUSHJ P,OUTTP ; SEND IT OUT + HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME + SKIPE A + ADD A,-2(P) ; RELOCATE IF NOT 0 + HLL A,2(C) + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST AB SLOT + ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST SP SLOT + ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP + SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH + PUSHJ P,OUTTP ; SEND IT OUT + HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P + MOVEI B,TPDL + PUSHJ P,MARK1 ;AND MARK IT + PUSHJ P,OUTTP ; SEND IT OUT + HLRE 0,TPSAV-PSAV+1(C) + MOVE A,TPSAV-PSAV+1(C) + SUB A,0 + MOVEI 0,1(A) + MOVE A,TPSAV-PSAV+1(C) + CAME 0,TPGROW ; SEE IF BLOWN + JRST MFRAM9 + MOVSI 0,PDLBUF + ADD A,0 +MFRAM9: ADD A,-2(P) + SUB A,-3(P) ; ADJUST + PUSHJ P,OUTTP + MOVE A,PCSAV-PSAV+1(C) + PUSHJ P,OUTTP + HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME + JRST TPMK4 ;AND DO MORE MARKING + + +MBIND: PUSHJ P,FIXBND + MOVEI B,TATOM ;FIRST MARK ATOM + SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW + SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP + JRST MBIND2 ; GO MARK + MOVE A,1(C) ; RESTORE A + CAME A,GCATM + JRST MBIND1 ; NOT IT, CONTINUE SKIPPING + HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0 + MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD + HRLM 0,2(C) ; SAVE FOR MOVEMENT + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEI LPVP,(C) ; POINT + SETOM (P) ; INDICATE PASSAGE +MBIND1: ADDI C,6 ; SKIP BINDING + MOVEI 0,6 + SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER + ADDM 0,-1(P) + JRST TPMK4 + +MBIND2: HLL A,(C) + PUSHJ P,OUTTP ; FIX UP CHAIN + MOVEI B,TATOM ; RESTORE IN CASE SMASHED + PUSHJ P,MARK1 ; MARK ATOM + PUSHJ P,OUTTP ; SEND IT OUT + ADDI C,2 + PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + PUSHJ P,MARK2 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE + ADDI C,2 + MOVEI B,TLIST ; POINT TO DECL SPECS + HLRZ A,(C) + PUSHJ P,MARK ; AND MARK IT + HRR A,(C) ; LIST FIX UP + PUSHJ P,OUTTP + SKIPL A,1(C) ; PREV LOC? + JRST NOTLCI + MOVEI B,TLOCI ; NOW MARK LOCATIVE + PUSHJ P,MARK1 +NOTLCI: PUSHJ P,OUTTP + ADDI C,2 + JRST TPMK4 + +FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN + SKIPE A ; DO NOTHING IF EMPTY + ADD A,-3(P) + POPJ P, +TPMK7: +TPMK8: MOVNI A,1 ; FENCE-POST THE STACK + PUSHJ P,OUTTP + ADDI C,1 ; INCREMENT C FOR FENCE-POST + SUB P,[1,,1] ; CLEAN UP STACK + POP P,E ; GET UPDATED PTR TO INF + SUB P,[2,,2] ; POP OFF RELOCATION + HRRZ A,(P) + HLRZ B,(A) + TRZ B,400000 + SUBI A,-1(B) + SUBI C,(A) ; GET # OF WORDS TRANSFERED + SUB B,C ; GET # LEFT + ADDI E,-2(B) ; ADJUST POINTER TO INF + POP P,A + POP P,C ; IS THERE TOP GROWH + ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH + ANDI E,-1 + PUSHJ P,DOPMOD ; FIX UP DOPE WORDS + PUSHJ P,DOPOUT ; SEND THEM OUT + JRST DOPEAD + + + ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR +; F= # OF WORDS TO ALLOCATE + +ALLOGC: HRRZS A ; GET ABS VALUE + SKIPN GCDFLG ; SKIP IF IN DUMPER + CAML A,GCSBOT ; SKIP IF IN STORAGE + JRST ALOGC2 ; JUMP IF ALLOCATING + HRRZ 0,A + POPJ P, +ALOGC2: PUSH P,A ; SAVE A +ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT + ADD 0,F ; SEE IF ITS ENOUGH + JUMPL 0,ALOCOK + MOVE F,0 ; MODIFY F + PUSH P,F + PUSHJ P,MOVFNT ; MOVE UP FRONTEIR + POP P,F + JRST ALOGC1 ; CONTINUE +ALOCOK: ADD FPTR,F ; MODIFY FPTR + HRLZS F + ADD FPTR,F + POP P,A ; RESTORE A + MOVEI 0,@BOTNEW + SUBI 0,1 ; RELOCATION PTR + POPJ P, ; EXIT + + + + +; TRBLK MOVES A VECTOR INTO THE INFERIOR +; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR + +TRBLK: HRRZS A + SKIPE GCDFLG + JRST TRBLK7 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLK7: PUSH P,A + HLRZ 0,(A) + TRZ 0,400000 ; TURN OFF GC FLAG + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR +TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR + ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1 + MOVE M,E ;SAVE E +TRBLK1: MOVE 0,R + SUBI E,1 + CAMGE R,FNTBOT ; SEE IF IN FRONTEIR + JRST TRBL10 + SUB E,FNTBOT ; ADJUST E + SUB 0,FNTBOT ; ADJ START + MOVEI A,FRONT+1777 + JRST TRBLK4 +TRBL10: CAML R,WNDBOT + CAML R,WNDTOP ; SEE IF IN WINDOW + JRST TRBLK5 ; NO + SUB E,WNDBOT + SUB 0,WNDBOT + MOVEI A,WIND+1777 +TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR + CAIL E,2000 + JRST TRNSWD + ADDI E,-1777(A) ; SUBTRACT WINDBOT + HRL 0,F ; SET UP FOR BLT + BLT 0,(E) + POP P,A + +FIXDOP: IORM D,(A) + MOVE E,M ; GET END OF WORD + POPJ P, +TRNSWD: PUSH P,B + MOVEI B,1(A) ; GET TOP OF WORLD + SUB B,0 + HRL 0,F + BLT 0,(A) + ADD F,B ; ADJUST F + ADD R,B + POP P,B + MOVE E,M ; RESTORE E + JRST TRBLK1 ; CONTINUE +TRBLK5: HRRZ A,R ; COPY E + ASH A,-10. ; TO PAGES + PUSH P,B ; SAVE B + MOVEI B,WNDP ; IT IS WINDOW + PUSHJ P,%SHWND + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE B + JRST TRBL10 + + + + +; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE + +TRBLKV: HRRZS A + SKIPE GCDFLG ; SKIP IF NOT IN DUMPER + JRST TRBLV2 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLV2: PUSH P,A ; SAVE A + HLRZ 0,DOPSV2 + TRZ 0,400000 + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR + SKIPGE -2(P) ; SEE IF SHRINKAGE + ADD 0,-2(P) ; IF SO COMPENSATE + JRST TRBLK2 ; CONTINUE + +; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS + +TRBLK3: PUSH P,A ; SAVE A + MOVE F,A + JRST TRBLK2 + +; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT +; F==> START OF TRANSFER IN GCS 0= # OF WORDS + +TRBLKX: PUSH P,A ; SAVE A + JRST TRBLK2 ; SEND IT OUT + + +; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN +; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED +; A CONTAINS THE WORD TO BE SENT OUT + +OUTTP: AOS E,-2(P) ; INCREMENT PLACE + MOVSI 0,(MOVEM) ; INS FOR SMINF + SOJA E,SMINF + + +; ADWD PLACES ONE WORD IN THE INF +; E ==> INF C IS THE WORD + +ADWD: PUSH P,E ; SAVE AC'S + PUSH P,A + MOVE A,C ; GET WORD + MOVSI 0,(MOVEM) ; INS FOR SMINF + PUSHJ P,SMINF ; SMASH IT IN + POP P,A + POP P,E + POPJ P, ; EXIT + +; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE +; SUCH AS THE TP AND GROWTH + + +DOPOUT: MOVE C,-1(A) + PUSHJ P,ADWD + ADDI E,1 + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT + PUSHJ P,ADWD + MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD + MOVEM C,-1(A) + MOVE C,DOPSV2 + MOVEM C,(A) ; RESTORE SECOND D.W. + POPJ P, + +; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF +; A ==> DOPE WORD E==> INF + +DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY + JRST .+3 + CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + MOVEM C,DOPSV1 + HLLZS C ; CLEAR OUT GROWTH + TLO C,.VECT. ; FIX UP FOR GCHACK + PUSH P,C + MOVE C,(A) ; GET SECOND DOPE WORD + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF MARK BIT + MOVEM C,DOPSV2 + HRRZ 0,-1(A) ; CHECK FOR GROWTH + JUMPE 0,DOPMD1 + LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 + LDB 0,[001100,,-1(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 +DOPMD1: HRL C,B ; FIX IT UP + MOVEM C,(A) ; FIX IT UP + POP P,-1(A) + POPJ P, + +ADPMOD: CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + TLO C,.VECT. ; FIX UP FOR GCHACK + MOVEM C,-1(A) + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF PARK BIT + MOVEM C,(A) + POPJ P, + + + + + ; RELATE RELATAVIZES A POINTER TO A VECTOR +; B IS THE POINTER A==> DOPE WORD + +RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER + JRST .+3 + CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE + POPJ P, ; IF NOT EXIT + MOVE C,-1(P) + HLRE F,C ; GET LENGTH + HRRZ 0,-1(A) ; CHECK FO GROWTH + JUMPE A,RELAT1 + LDB 0,[111100,,-1(A)] ; GET TOP GROWTH + TRZE 0,400 ; HACK SIGN BIT + MOVNS 0 + ASH 0,6 ; CONVERT TO WORDS + SUB F,0 ; ACCOUNT FOR GROWTH +RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER + HRRZ F,(A) ; GET RELOCATED ADDR + SUBI F,(A) ; FIND RELATIVIZATION AMOUNT + ADD C,F ; ADJUST POINTER + SUB C,0 ; ACCOUNT FOR GROWTH + MOVEM C,-1(P) + POPJ P, + + + + ; MARK TB POINTERS +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET ; IF POINTING TO NIL THEN RETURN + HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER + HRRZ C,TPSAV(A) ; GET TO DOPE WORD +TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD + HRRZ A,(P) ; GET PTR TO FRAME + SUB A,C ; GET PTR TO FRAME + HRLS A + HRR A,(P) + PUSH P,A + MOVEI C,-1(P) + MOVEI B,TTP + PUSHJ P,MARK + SUB P,[1,,1] + HRRM A,(P) + JRST GCRET +ABMK: HLRE B,A ; FIX UP TO GET TO FRAME + SUB A,B + HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP + HRRZ C,FRAMLN+TPSAV(A) + JRST TBMK2 + + + +; MARK ARG POINTERS + +ARGMK: HRRZ A,1(C) ; GET POINTER + HLRE B,1(C) ; AND LNTH + SUB A,B ; POINT TO BASE + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST ARGMK0 + HLRZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK + CAIN 0,TCBLK + JRST ARGMK1 + CAIE 0,TENTRY ; IS NEXT A WINNER? + CAIN 0,TINFO + JRST ARGMK1 ; YES, GO ON TO WIN CODE + +ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL + SETZM (P) ; AND SAVED COPY + JRST GCRET + +ARGMK1: MOVE B,1(A) ; ASSUME TTB + ADDI B,(A) ; POINT TO FRAME + CAIE 0,TINFO ; IS IT? + MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE + HLRZ 0,OTBSAV(B) ; GET TIME + HRRZ A,(C) ; AND FROM POINTER + CAIE 0,(A) ; SKIP IF WINNER + JRST ARGMK0 + MOVE A,TPSAV(B) ; GET A RELATAVIZED TP + HRROI C,TPSAV-1(B) + MOVEI B,TTP + PUSHJ P,MARK1 + SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS + HRRZ B,(P) + ADD B,A + HRRM B,(P) ; PUT RELATAVIZED PTR BACK + JRST GCRET + + +; MARK FRAME POINTERS + +FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAME B,F ; SEE IF EQUAL + JRST GCRET + SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR + HRRZ A,1(C) ;USE AS DATUM + SUBI A,1 ;FUDGE FOR VECTMK + MOVEI B,TPVP ;IT IS A VECTRO + PUSHJ P,MARK ;MARK IT + ADDI A,1 ; READJUST PTR + HRRM A,1(C) ; FIX UP PROCESS SLOT + MOVEI C,1(C) ; SET UP FOR TBMK + HRRZ A,(P) + JRST TBMK ; MARK LIKE TB + + +; MARK BYTE POINTER + +BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A + HLRZ F,-1(A) ; GET THE TYPE + ANDI F,SATMSK ; FLUSH MONITOR BITS + CAIN F,SATOM ; SEE IF ATOM + JRST ATMSET + HLRE F,(A) ; GET MARKING + JUMPL F,BYTREL ; JUMP IF MARKED + HLRZ F,(A) ; GET LENGTH + PUSHJ P,ALLOGC ; ALLOCATE FOR IT + HRRM 0,(A) ; SMASH IT IN + MOVE E,0 + HLRZ F,(A) + SUBI E,-1(F) ; ADJUST INF POINTER + IORM D,(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +BYTREL: HRRZ E,(A) + SUBI E,(A) + ADDM E,(P) ; RELATAVIZE + JRST GCRET + +ATMSET: PUSH P,A ; SAVE A + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + MOVNI B,-2(B) ; GET LENGTH + ADDI A,-1(B) ; CALCULATE POINTER + HRLI A,(B) + MOVEI B,TATOM ; TYPE + PUSHJ P,MARK + POP P,A ; RESTORE A + SKIPN DUMFLG + JRST BYTREL + HRRM A,(P) + MOVSI E,STATM ; GET "STRING IS ATOM BIT" + IORM E,(P) + JRST BYTREL ; TO BYTREL + + +; MARK OFFSET + +OFFSMK: HLRZS A + PUSH P,$TLIST + PUSH P,A ; PUSH LIST POINTER ON THE STACK + MOVEI C,-1(P) ; POINTER TO PAIR + PUSHJ P,MARK2 ; MARK THE LIST + HRLM A,-2(P) ; UPDATE POINTER IN OFFSET + SUB P,[2,,2] + JRST GCRET + + +; MARK ATOMS IN GVAL STACK + +GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL + JUMPE B,ATOMK + CAIN B,-1 + JRST ATOMK + MOVEI A,(B) ; POINT TO DECL FOR MARK + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK + HLRZ C,-1(P) ; RESTORE HOME POINTER + HRRM A,(C) ; CLOBBER UPDATED LIST IN + MOVE A,1(C) ; RESTORE ATOM POINTER + +; MARK ATOMS + +ATOMK: + MOVEI 0,@BOTNEW + PUSH P,0 ; SAVE POINTER TO INF + TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED + MOVEI C,1(A) + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ATMRL1 ; ALREADY MARKED + PUSH P,A ; SAVE DOPE WORD PTR FOR LATER + HLRZ C,(A) ; FIND REAL ATOM PNTR + SUBI C,400001 ; KILL MARK BIT AND ADJUST + HRLI C,-1(C) + SUBM A,C ; NOW TOP OF ATOM +MRKOBL: MOVEI B,TOBLS + HRRZ A,2(C) ; IF > 0, NOT OBL + CAMG A,VECBOT + JRST .+3 + HRLI A,-1 + PUSHJ P,MARK ; AND MARK IT + HRRM A,2(C) + SKIPN GCHAIR + JRST NOMKNX + HLRZ A,2(C) + MOVEI B,TATOM + PUSHJ P,MARK + HRLM A,2(C) +NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B + CAIN B,TUNBOUND + JRST ATOMK1 ; IT IS UNBOUND + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 + MOVEI B,TTP ; ITS A LOCAL VALUE + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH INTO SLOT +ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT + POP P,A ; RESTORE A + POP P,E ; GET POINTER INTO INF + SKIPN GCHAIR + JUMPN 0,ATMREL + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +ATMREL: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET +ATMRL1: SUB P,[1,,1] ; POP OFF STACK + JRST ATMREL + + +GETLNT: HLRE B,A ;GET -LNTH + SUB A,B ;POINT TO 1ST DOPE WORD + MOVEI A,1(A) ;POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;BAD VECTOR, COMPLAIN + HLRE B,(A) ;GET LENGTH AND MARKING + IORM D,(A) ;MAKE SURE MARKED + JUMPL B,AMTKE + MOVEI F,(B) ; AMOUNT TO ALLOCATE + PUSHJ P,ALLOGC ;ALLOCATE ROOM + HRRM 0,(A) ; RELATIVIZE +AMTK1: AOS (P) ; A NON MARKED ITEM +AMTKE: POPJ P, ;AND RETURN + +GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS + JRST GCRET + + + +; MARK NON-GENERAL VECTORS + +NOTGEN: CAMN B,[GENERAL+] + JRST GENRAL ;YES, MARK AS A VECTOR + JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK + SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR + HLRZS B ;ISOLATE TYPE + ANDI B,TYPMSK + PUSH P,E + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL + POP P,E ; RESTORE LENGTH + MOVE F,B ; AND COPY IT + LSH B,1 ;FIND OUT WHERE IT WILL GO + HRRZ B,@TYPNT ;GET SAT IN B + ANDI B,SATMSK + MOVEI C,@MKTBS(B) ;POINT TO MARK SR + CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE + JRST UMOVEC + MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START + PUSH P,E ;SAVE NUMBER OF ELEMENTS + PUSH P,F ;AND UNIFORM TYPE + +UNLOOP: MOVE B,(P) ;GET TYPE + MOVE A,1(C) ;AND GOODIE + TLO C,400000 ;CAN'T MUNG TYPE + PUSHJ P,MARK ;MARK THIS ONE + MOVEM A,1(C) ; LIST FIXUP + SOSE -1(P) ;COUNT + AOJA C,UNLOOP ;IF MORE, DO NEXT + + SUB P,[2,,2] ;REMOVE STACK CRAP + JRST UMOVEC + + +SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR + SUB P,[4,,4] ; REOVER + JRST AFIXUP + + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: PUSH P,A ; SAVE PTR TO TOP + MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING + JRST GCRDRL ; RELATIVIZE + PUSH P,A ; SAVE D.W POINTER + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + HRRZ 0,-2(P) + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRD2 + 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 + MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 +GCRD2: POP P,A ; GET PTR TO D.W. + POP P,E ; GET PTR TO INF + SUB P,[1,,1] ; GET RID OF TOP + PUSHJ P,ADPMOD ; FIX UP D.W. + PUSHJ P,TRBLK ; SEND IT OUT + JRST ATMREL ; RELATIVIZE AND LEAVE +GCRDRL: POP P,A ; GET PTR TO D.W + SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF + JRST ATMREL ; RELATAVIZE + + + +;MARK RELATAVIZED GLOC HACKS + +LOCRMK: SKIPE GCHAIR + JRST GCRET +LOCRDP: PUSH P,C ; SAVE C + MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM + ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM + MOVEI B,TATOM ; ITS AN ATOM + SKIPL (C) + PUSHJ P,MARK1 + POP P,C ; RESTORE C + SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR + JRST LOCRDD + MOVEI B,1 + IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR + CAIA +LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION + MOVEM A,(P) ; IT STAYS THE SAVE + JRST GCRET + +;MARK LOCID TYPE GOODIES + +LOCMK: HRRZ B,(C) ;GET TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + SETZB A,(P) ; NO, SMASH LOCATIVE + JUMPE A,GCRET ; LEAVE IF DONE +LOCMK1: PUSH P,C + MOVEI B,TATOM ; MARK ATOM + MOVEI C,-2(A) ; POINT TO ATOM + MOVE E,(C) ; SEE IF BLOCK IS MARKED + TLNE E,400000 ; SKIP IF MARKED + JRST LOCMK2 ; SKIP OVER BLOCK + SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED) + PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM +LOCMK2: POP P,C + HRRZ E,(C) ; TIME BACK + MOVEI B,TVEC ; ASSUME GLOBAL + SKIPE E + MOVEI B,TTP ; ITS LOCAL + PUSHJ P,MARK1 ; MARK IT + MOVEM A,(P) + JRST GCRET + + +; MARK ASSOCIATION BLOCKS + +ASMRK: PUSH P,A +ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ASTREL ; ALREADY MARKED + MOVEI C,-ASOLNT-1(A) ;COPY POINTER + PUSHJ P,MARK2 ;MARK ITEM CELL + MOVEM A,1(C) + ADDI C,INDIC-ITEM ;POINT TO INDICATOR + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-INDIC + PUSHJ P,MARK2 + MOVEM A,1(C) + SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS + JRST ASTREL + HRRZ A,NODPNT-VAL(C) ; NEXT + JUMPN A,ASMRK1 ; IF EXISTS, GO +ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION + MOVEI A,ASOLNT+1(A) ; POINT TO D.W. + SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR + JRST ASTX ; JUMP TO SEND OUT +ASTR1: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET ; EXIT +ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING + PUSHJ P,ADPMOD + PUSHJ P,TRBLK + JRST ASTR1 + +;HERE WHEN A VECTOR POINTER IS BAD + +VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE + SUB P,[1,,1] ; RECOVERY +AFIXUP: SETZM (P) ; CLOBBER SLOT + JRST GCRET ; CONTINUE + + +VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE + SUB P,[2,,2] + JRST AFIXUP ; RECOVER + +PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE + SUB P,[1,,1] ; RECOVER + JRST AFIXUP + + + ; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + 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 + PUSHJ P,GETLNT ; GOODIE IS NOW MARKED + JRST TMPREL ; ALREADY MARKED + + 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,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + 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,-5(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,-6(P) ; SAVE ELMENT # + SKIPN B,-5(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,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(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 + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + EXCH A,B ; REARRANGE + GETYP B,B + MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE + MOVE E,TD.PUT+1 + MOVE B,-6(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + ADDI E,(B)-1 ; POINT TO SLOT + MOVE B,-3(P) ; RESTORE TYPE WORD + EXCH A,B + SOS D,-1(P) ; GET ELEMENT # + XCT (E) ; SMASH IT BACK + FATAL TEMPLATE LOSSAGE + MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD + MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR + SUB P,[7,,7] ; CLEAN UP STACK +USRAG1: ADDI A,1 ; POINT TO SECOND D.W. + MOVSI D,400000 ; SET UP MARK BIT + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; SEND IT OUT +TMPREL: SUB P,[1,,1] + HRRZ D,(A) + SUBI D,(A) + ADDM D,(P) + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST GCRET + +USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE + PUSHJ P,(E) + MOVE A,-1(P) ; POINTER TO D.W + MOVE E,(P) ; TOINTER TO FRONTIER + JRST USRAG1 + +; This phase attempts to remove any unwanted associations. The program +; loops through the structure marking values of associations. It can only +; stop when no new values (potential items and/or indicators) are marked. + +VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER + PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS + PUSH P,[0] ; OR THIS BUCKET +ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER + SETOM -1(P) ; INITIALIZE FLAG + +ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED + JRST ASOM1 + SETOM (P) ; SAY BUCKET NOT CHANGED + +ASOM2: MOVEI F,(C) ; COPY POINTER + SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED + JRST ASOM4 ; MARKED, GO ON + PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED + JRST ASOM3 ; IT IS NOT, IGNORE IT + MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2 + MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT + PUSHJ P,MARKQ + JRST ASOM3 ; NOT MARKED + + PUSH P,A ; HERE TO MARK VALUE + PUSH P,F + HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH + JUMPL F,.+3 ; SKIP IF MARKED + CAMGE C,VECBOT ; SKIP IF IN VECT SPACE + JRST ASOM20 + HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION + MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF + PUSHJ P,ALLOGC + HRRM 0,5(C) ; STICK IN RELOCATION + +ASOM20: PUSHJ P,MARK2 ; AND MARK + MOVEM A,1(C) ; LIST FIX UP + ADDI C,ITEM-INDIC ; POINT TO ITEM + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-ITEM ; POINT TO VALUE + PUSHJ P,MARK2 + MOVEM A,1(C) + IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK + POP P,F + POP P,A + AOSA -1(P) ; INDICATE A MARK TOOK PLACE + +ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET +ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET + JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE + SKIPGE (P) ; SKIP IF ANY NOT MARKED + HRROS (A) ; MARK BUCKET AS NOT INTERESTING +ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET + TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED? + JRST VALFLA ; YES, CHECK VALUES +VALFL8: + +; NOW SEE WHICH CHANNELS STILL POINTED TO + +CHNFL3: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +CHNFL2: SKIPN B,1(A) + JRST CHNFL1 + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + HLLM A,(A) ; PUT TYPE BACK + HRRE F,(A) ; SEE IF ALREADY MARKED + JUMPN F,CHNFL1 + SKIPGE 1(B) + JRST CHNFL8 + HLLOS (A) ; MARK AS A LOSER + SETZM -1(P) + JRST CHNFL1 +CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL + HRRM F,(A) +CHNFL1: ADDI A,2 + SOJG 0,CHNFL2 + + SKIPE GCHAIR ; IF NOT HAIRY CASE + POPJ P, ; LEAVE + + SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED + JRST ASOMK1 + + SUB P,[2,,2] ; REMOVE FLAGS + + + +; HERE TO REEMOVE UNUSED ASSOCIATIONS + + MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES + +ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY + JRST ASOFL2 ; EMPTY BUCKET, IGNORE + HRRZS (A) ; UNDO DAMAGE OF BEFORE + +ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED + JRST ASOFL6 ; MARKED, DONT FLUSH + + HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER + HLRZ E,ASOLNT-1(C) ; AND BACK POINTER + JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET) + HRRZM B,(A) ; FIX BUCKET + JRST .+2 + +ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS + JUMPE B,.+2 ; JUMP IF NO NEXT POINTER + HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER + HRRZ B,NODPNT(C) ; SPLICE OUT THRAD + HLRZ E,NODPNT(C) + SKIPE E + HRRM B,NODPNT(E) + SKIPE B + HRLM E,NODPNT(B) + +ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT + JUMPN C,ASOFL5 +ASOFL2: AOBJN A,ASOFL1 + + + +; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES + + MOVE A,GCGBSP ; GET GLOBAL PDL + +GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED + JRST SVDCL + MOVSI B,-3 + PUSHJ P,ZERSLT ; CLOBBER THE SLOT + HLLZS (A) +SVDCL: ANDCAM D,(A) ; UNMARK + ADD A,[4,,4] + JUMPL A,GLOFLS ; MORE?, KEEP LOOPING + + MOVEM LPVP,(P) +LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS + HRRZ C,2(LPVP) + MOVEI LPVP,(C) + JUMPE A,LOCFL2 ; NONE TO FLUSH + +LOCFLS: SKIPGE (A) ; MARKDE? + JRST .+3 + MOVSI B,-5 + PUSHJ P,ZERSLT + ANDCAM D,(A) ;UNMARK + HRRZ A,(A) ; GO ON + JUMPN A,LOCFLS +LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS + +; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT. +; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT +; SENDS OUT THE ATOMS. + +LOCFL3: MOVE C,(P) + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEM A,1(C) ; NEW HOME + MOVEI C,2(C) ; MARK VALUE + MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) + POP P,R +NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT + HLRZ A,2(R) ; GET PTR TO NEXT PROCESS + HRLM 0,2(R) + HRRZ E,(A) ; ADRESS IN INF + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + PUSH P,B + HRRZ F,A ; CALCULATE START OF TP IN F + HLRZ B,(A) ; ADJUST INF PTR + TRZ B,400000 + SUBI F,-1(B) + LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH + TRZE M,400 ; FUDGE SIGN + MOVNS M + ASH M,6 + ADD B,M ; FIX UP LENGTH + EXCH M,(P) + SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH + MOVE M,R ; GET A COPY OF R +NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN + JUMPE C,NEXP2 ; EXIT IF END OF CHAIN + MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE + ADD 0,(P) ; UPDATE + HRRM 0,(M) ; PUT IN + MOVE M,C ; NEXT + JRST NEXP1 +NEXP2: SUB P,[1,,1] ; CLEAN UP STACK + SUBI E,-1(B) + HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING + MOVEI B,6(B) ; POINT AFTER THE BINDING + MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT + SUBM B,0 + PUSH P,R ; PRESERVE R + PUSHJ P,TRBLKX ; SEND IT OUT + POP P,R ; RESTORE R + HRRZS R,2(R) ; GET THE NEXT PROCESS + SKIPN R + JRST .+3 + PUSH P,R + JRST LOCFL3 + MOVE A,GCGBSP ; PTR TO GLOBAL STACK + PUSHJ P,SPCOUT ; SEND IT OUT + MOVE A,GCASOV + PUSHJ P,SPCOUT ; SEND IT OUT + POPJ P, + +; THIS ROUTINE MARKS ALL THE CHANNELS +; IT THEN SENDS OUT A COPY OF THE TVP + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +DHNFL2: SKIPN B,1(A) + JRST DHNFL1 + MOVEI C,(A) ; MARK THE CHANNEL + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + PUSHJ P,MARK2 + MOVEM A,1(C) ; ADJUST PTR + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + +; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR + +SPCOUT: HLRE B,A + SUB A,B + MOVEI A,1(A) ; POINT TO DOPE WORD + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSHJ P,DOPMOD + HRRZ E,(A) ; GET PTR TO INF + HLRZ B,(A) ; LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + SUBI E,-1(B) + ADD E,0 + PUSH P,0 ; DUMMY FOR TRBLKV + PUSHJ P,TRBLKV ; OUT IT GOES + SUB P,[1,,1] + POPJ P, ;RETURN + +ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET + JUMPN E,ASOFL3 ; IF NOT CONTINUE + HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION + HRRZM E,(A) ; SMASH IT IN + JRST ASOFL3 + + +MARK23: PUSH P,A ; SAVE BUCKET POINTER + PUSH P,F + PUSHJ P,MARK2 + MOVEM A,1(C) + POP P,F + POP P,A + AOS -2(P) ; MARKING HAS OCCURRED + IORM D,ASOLNT+1(C) ; MARK IT + JRST MKD + + ; CHANNEL FLUSHER FOR NON HAIRY GC + +CHNFLS: PUSH P,[-1] + SETOM (P) ; RESET FOR RETRY + PUSHJ P,CHNFL3 + SKIPL (P) + JRST .-3 ; REDO + SUB P,[1,,1] + POPJ P, + +; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP + +VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK +VALFL1: SKIPL (C) ; SKIP IF NOT MARKED + PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED + JRST VALFL2 + PUSH P,C + MOVEI B,TATOM ; UPDATE ATOM SLOT + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + AOS -2(P) ; INDICATE MARK OCCURRED + HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,VLFL10 ; NONE + CAIN B,-1 ; MAINFIFEST + JRST VLFL10 + MOVEI A,(B) + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK ; MARK IT + MOVE C,(P) ; POINT + HRRM A,(C) ; CLOBBER UPDATE IN +VLFL10: ADD C,[2,,2] ; BUMP TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + POP P,C +VALFL2: ADD C,[4,,4] + JUMPL C,VALFL1 ; JUMP IF MORE + + HRLM LPVP,(P) ; SAVE POINTER +VALFL7: MOVEI C,(LPVP) + MOVEI LPVP,0 +VALFL6: HRRM C,(P) + +VALFL5: HRRZ C,(C) ; CHAIN + JUMPE C,VALFL4 + MOVEI B,TATOM ; TREAT LIKE AN ATOM + SKIPL (C) ; MARKED? + PUSHJ P,MARKQ1 ; NO, SEE + JRST VALFL5 ; LOOP + AOS -1(P) ; MARK WILL OCCUR + MOVEI B,TATOM ; RELATAVIZE + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + ADD C,[2,,2] ; POINT TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + SUBI C,2 + JRST VALFL5 + +VALFL4: HRRZ C,(P) ; GET SAVED LPVP + MOVEI A,(C) + HRRZ C,2(C) ; POINT TO NEXT + JUMPN C,VALFL6 + JUMPE LPVP,VALFL9 + + HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED + JRST VALFL7 + +ZERSLT: HRRI B,(A) ; COPY POINTER + SETZM 1(B) + AOBJN B,.-1 + POPJ P, + +VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN + JRST VALFL8 + + ;SUBROUTINE TO SEE IF A GOODIE IS MARKED +;RECEIVES POINTER IN C +;SKIPS IF MARKED NOT OTHERWISE + +MARKQ: HLRZ B,(C) ;TYPE TO B +MARKQ1: MOVE E,1(C) ;DATUM TO C + MOVEI 0,(E) + CAIL 0,@PURBOT ; DONT CHACK PURE + JRST MKD ; ALWAYS MARKED + ANDI B,TYPMSK ; FLUSH MONITORS + LSH B,1 + HRRZ B,@TYPNT ;GOBBLE SAT + ANDI B,SATMSK + CAIG B,NUMSAT ; SKIP FOR TEMPLATE + JRST @MQTBS(B) ;DISPATCH + ANDI E,-1 ; FLUSH REST HACKS + JRST VECMQ + + +MQTBS: + +OFFSET 0 + +DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] +[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ] +[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ] +[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ] +[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]] + +OFFSET OFFS + +PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED + SKIPL (E) ; SKIP IF MARKED + POPJ P, +ARGMQ: +MKD: AOS (P) + POPJ P, + +BYTMQ: PUSH P,A ; SAVE A + PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD + MOVE E,A ; COPY POINTER + POP P,A ; RESTORE A + SKIPGE (E) ; SKIP IF NOT MARKED + AOS (P) + POPJ P, ; EXIT + +FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD + SOJA E,VECMQ1 + +ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS + JRST VECMQ + AOS (P) + POPJ P, + +VECMQ: HLRE 0,E ;GET LENGTH + SUB E,0 ;POINT TO DOPE WORDS + +VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED + AOS (P) ;MARKED, CAUSE SKIP RETURN + POPJ P, + +ASMQ: ADDI E,ASOLNT + JRST VECMQ1 + +LOCMQ: HRRZ 0,(C) ; GET TIME + JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR + HLRE 0,E ; FIND DOPE + SUB E,0 + MOVEI E,1(E) ; POINT TO LAST DOPE + CAMN E,TPGROW ; GROWING? + SOJA E,VECMQ1 ; YES, CHECK + ADDI E,PDLBUF ; FUDGE + MOVSI 0,-PDLBUF + ADDM 0,1(C) + SOJA E,VECMQ1 + +OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE + SKIPGE (E) ; MARKED? + AOS (P) ; YES + POPJ P, + + ; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF + +ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN +ASSOP1: HRRZ B,NODPNT(A) + PUSH P,B ; SAVE NEXT ON CHAIN + PUSH P,A ; SAVE IT + HRRZ B,ASOLNT-1(A) ;POINT TO NEXT + JUMPE B,ASOUP1 + HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER +ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER + JUMPE B,ASOUP2 + HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION + SUBI F,ASOLNT+1(B) ; RELATIVIZE + MOVSI F,(F) + ADDM F,ASOLNT-1(A) ;RELOCATE +ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN + JUMPE B,ASOUP4 + HRRZ C,ASOLNT+1(B) ;GET RELOC + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,NODPNT(A) ;AND UPDATE +ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER + JUMPE B,ASOUP5 + HRRZ F,ASOLNT+1(B) ;RELOC + SUBI F,ASOLNT+1(B) + MOVSI F,(F) + ADDM F,NODPNT(A) +ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD + MOVEI A,ASOLNT+1(A) + MOVSI B,400000 ;UNMARK IT + XORM B,(A) + HRRZ E,(A) ; SET UP PTR TO INF + HLRZ B,(A) + SUBI E,-1(B) ; ADJUST PTR + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,A ; RECOVER PTR TO ASSOCIATION + JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP + POPJ P, ; DONE + + +; HERE TO CLEAN UP ATOM HASH TABLE + +ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER + +ATCLE1: MOVEI B,0 + SKIPE C,(A) ; GET NEXT + JRST ATCLE2 ; GOT ONE + +ATCLE3: PUSHJ P,OUTATM + AOBJN A,ATCLE1 + + MOVE A,GCHSHT ; MOVE OUT TABLE + PUSHJ P,SPCOUT + POPJ P, + +; HAVE AN ATOM IN C + +ATCLE2: MOVEI B,0 + +ATCLE5: CAIL C,HIBOT + JRST ATCLE3 + CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED + JRST .+3 + SKIPL 1(C) ; SKIP IF ATOM MARKED + JRST ATCLE6 + + HRRZ 0,1(C) ; GET DESTINATION + CAIN 0,-1 ; FROZEN/MAGIC ATOM + MOVEI 0,1(C) ; USE CURRENT POSN + SUBI 0,1 ; POINT TO CORRECT DOPE + JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM + + HRRZM 0,(A) ; INTO HASH TABLE + JRST ATCLE8 + +ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM + PUSHJ P,OUTATM + +ATCLE8: HLRZ B,1(C) + ANDI B,377777 ; KILL MARK BIT + SUBI B,2 + HRLI B,(B) + SUBM C,B + HLRZ C,2(B) + JUMPE C,ATCLE3 ; DONE WITH BUCKET + JRST ATCLE5 + +; HERE TO PASS OVER LOST ATOM + +ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM + SUBI C,-2(F) + HLRZ C,2(C) + JUMPE B,ATCLE9 + HRLM C,2(B) + JRST .+2 +ATCLE9: HRRZM C,(A) + JUMPE C,ATCLE3 + JRST ATCLE5 + +OUTATM: JUMPE B,CPOPJ + PUSH P,A + PUSH P,C + HLRE A,B + SUBM B,A + MOVSI D,400000 ;UNMARK IT + XORM D,1(A) + HRRZ E,1(A) ; SET UP PTR TO INF + HLRZ B,1(A) + SUBI E,-1(B) ; ADJUST PTR + MOVEI A,1(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,C + POP P,A ; RECOVER PTR TO ASSOCIATION + POPJ P, + + +VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH + + +; 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 /] + +.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL +.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX +.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP +.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB +.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG +.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN +.GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR + + +;LOCAL VARIABLES + +OFFSET 0 + +IMPURE +; LOCACTIONS USED BY THE PAGE HACKER + +DOPSV1: 0 ;SAVED FIRST D.W. +DOPSV2: 0 ; SAVED LENGTH + + +; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS. +; + +GCNO: 0 ; USER-CALLED GC +BSTGC: 0 ; FREE STORAGE + 0 ; BLOWN TP + 0 ; TOP-LEVEL LVALS + 0 ; GVALS + 0 ; TYPE + 0 ; STORAGE + 0 ; P-STACK + 0 ; BOTH STATCKS BLOWN + 0 ; STORAGE + +BSTAT: +NOWFRE: 0 ; FREE STORAGE FROM LAST GC +CURFRE: 0 ; STORAGE USED SINCE LAST GC +MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED +USEFRE: 0 ; TOTAL FREE STORAGE USED +NOWTP: 0 ; TP LENGTH FROM LAST GC +CURTP: 0 ; # WORDS ON TP +CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR +NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS +CURLVL: 0 ; # OF TOP-LEVEL LVALS +NOWGVL: 0 ; # OF GVAL SLOTS +CURGVL: 0 ; # OF GVALS +NOWTYP: 0 ; SIZE OF TYPE-VECTOR +CURTYP: 0 ; # OF TYPES +NOWSTO: 0 ; SIZE OF STATIONARY STORAGE +CURSTO: 0 ; STATIONARY STORAGE IN USE +CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE +NOWP: 0 ; SIZE OF P-STACK +CURP: 0 ; #WORDS ON P +CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR +GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC +GCCALL: 0 ; INDICATOR FOR CALLER OF GC + + +; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW +LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS +GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS +TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES +STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE) + + +RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS +RCLV: 0 ; POINTER TO RECYCLED VECTORS +GCMONF: 0 ; NON-ZERO SAY GIN/GOUT +GCDANG: 0 ; NON-ZERO, STORAGE IS LOW +INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT +GETNUM: 0 ;NO OF WORDS TO GET +RFRETP: +RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY +CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY +NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS + +;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE, +;AND WHEN IT WILL GET UNHAPPY + +FREMIN: 20000 ;MINIMUM FREE WORDS + +;POINTER TO GROWING PDL + +TPGROW: 0 ;POINTS TO A BLOWN TP +PPGROW: 0 ;POINTS TO A BLOWN PP +PGROW: 0 ;POINTS TO A BLOWN P + +;IN GC FLAG + +GCFLG: 0 +GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS +GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY +GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN +CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR +PURMIN: 0 ; MINIMUM PURE STORAGE + +; VARS ASSOCIATED WITH BLOAT LOGIC +PMIN: 200 ; MINIMUM FOR PSTACK +PGOOD: 1000 ; GOOD SIZE FOR PSTACK +PMAX: 4000 ; MAX SIZE FOR PSTACK +TPMIN: 1000 ; MINIMUM SIZE FOR TP +TPGOOD: NTPGOO ; GOOD SIZE OF TP +TPMAX: NTPMAX ; MAX SIZE OF TP + +TPBINC: 0 +GLBINC: 0 +TYPINC: 0 + +; VARS FOR PAGE WINDOW HACKS + +GCHSHT: 0 ; SAVED ATOM TABLE +PURSVT: 0 ; SAVED PURVEC TABLE +GLTOP: 0 ; SAVE GLOTOP +GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN +GCGBSP: 0 ; SAVED GLOBAL SP +GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR +GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS +FNTBOT: 0 ; BOTTOM OF FRONTEIR +WNDBOT: 0 ; BOTTOM OF WINDOW +WNDTOP: 0 +BOTNEW: (FPTR) ; POINTER TO FRONTIER +GCTIM: 0 +NPARBO: 0 ; SAVED PARBOT + +; FLAGS TO INDICATE DUMPER IS IN USE + +GPURFL: 0 ; INDICATE PURIFIER IS RUNNING +GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING +DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING + +; CONSTANTS FOR DUMPER,READER AND PURIFYER + +ABOTN: 0 ; COUNTER FOR ATOMS +NABOTN: 0 ; POINTER USED BY PURIFY +OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER +MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF +SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER +SAVRE2: 0 ; SAVED TYPE WORD +SAVRS1: 0 ; SAVED PTR TO OBJECT +INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF +INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF +INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE + +; VARIABLES USED BY GC INTERRUPT HANDLER + +GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED +GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT + +; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN + +PSHGCF: 0 + +; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES + +TYPTAB: 0 ; POINTER TO TYPE TABLE +NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT +NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT +TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR + +; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING + +BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING +PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP +RPURBT: 0 ; SAVED VALUE OF PURTOP +RGCSTP: 0 ; SAVED GCSTOP + +; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO + +INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP +PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE + ; ARE NOT GENERATED + + +PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION +NPRFLG: 0 + +; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR + +MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT + +PURE + +OFFSET OFFS + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + + +OFFSET OFFS + +WIND: SPBLOK 2000 +FRONT: SPBLOK 2000 +MRKPD: SPBLOK 1777 +ENDPDL: -1 + +MRKPDL=MRKPD-1 + +ENDGC: + +OFFSET 0 + +.LOP WIND <,-10.> +WNDP==.LVAL1 + +.LOP FRONT <,-10.> +FRNP==.LVAL1 + +ZZ2==ENDGC-AGCLD +.LOP ZZ2 <,-10.> +LENGC==.LVAL1 + +.LOP LENGC <,10.> +RLENGC==.LVAL1 + +.LOP AGCLD <,-10.> +PAGEGC==.LVAL1 + +OFFSET 0 + +LOC GCST +.LPUR==$. + +END +