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