--- /dev/null
+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,%PURMD
+.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
+
+\f
+; 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\r
+ 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
+
+\f
+; 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
+ PUSHJ P,%PURMD
+
+ 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,SCHSTR
+ JRST STRFXP
+ CAIN A,SATOM
+ JRST ATMFXP
+ CAIN A,SOFFS
+ JRST OFFFXP ; FIXUP OFFSETS
+STRFXQ: 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
+
+STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM
+ JRST STRFXQ
+ MOVEM D,1(B)
+ PUSH P,C
+ MOVE C,B ; GET ARG FOR BYTDOP
+ PUSHJ P,BYTDOP
+ POP P,C
+ MOVEI D,-1(A)
+ JRST ATMFXQ
+
+ATMFXP: HLRE 0,D ; GET LENGTH
+ SUB D,0 ; POINT TO FIRST DOPE WORD
+ HRRZS D
+ATMFXQ: 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
+ JRST PURSFX
+ HLRE E,D ; GET TO DOPE WORD
+ SUBM D,E
+PURSF1: 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,
+
+PURSFX: CAIE C,TCHSTR
+ POPJ P,
+ MOVE C,B ; GET ARG FOR BYTDOP
+ PUSHJ P,BYTDOP
+ GETYP 0,-1(A)
+ MOVEI E,-1(A)
+ MOVE A,[PUSHJ P,PURTFX]
+ CAIE 0,SATOM
+ POPJ P,
+ JRST PURSF1
+
+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
+ GETYP 0,-1(A)
+ MOVE D,1(B)
+ MOVEI C,-1(A)
+ CAIN 0,SATOM ; REALLY ATOM?
+ JRST ATPFX1
+ 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
+ATPFX1: 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
+
+\f
+.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
+
+
+\f
+.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
+
+\f
+
+; 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,<SETZ BYTMK>],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP]
+[SLOCID,ERDP],[SCHSTR,<SETZ BYTMK>],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP]
+[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ERDP]
+[SLOCB,<SETZ BYTMK>],[SLOCR,LOCRDP],[SOFFS,OFFSMK]]
+
+OFFSET OFFS
+
+\f
+; 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
+
+
+\f
+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
+
+\f; 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
+
+
+
+\f; 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
+
+\f; 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,
+
+
+\f;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
+
+
+\f;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
+
+\f; 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
+
+
+\f; 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,
+
+
+\f;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
+
+
+
+\f; 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
+
+\f; 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
+
+\f
+; 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
+
+
+\f; 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,
+
+
+
+
+\f; 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,
+
+
+
+\f; 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
+
+
+\f
+; 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
+
+\f
+; 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
+
+\f
+; 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 GCDFLG
+ JRST BYTREL
+ MOVSI E,STATM ; GET "STRING IS ATOM BIT"
+ IORM E,(P)
+ SKIPN DUMFLG
+ JRST GCRET
+ HRRM A,(P)
+ JRST BYTREL ; TO BYTREL
+\f
+
+; 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
+\f
+
+; 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
+
+\f
+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
+
+
+\f
+; MARK NON-GENERAL VECTORS
+
+NOTGEN: CAMN B,[GENERAL+<SPVP,,0>]
+ 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
+
+
+\f
+; 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
+
+
+\f
+;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
+
+\f
+; 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
+
+
+\f; 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
+
+
+\f
+; 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
+
+\f; 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
+
+\f;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,
+
+\f; 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
+
+\f
+; 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,
+
+\f
+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
+
+\f
+;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 <ASH @> WIND <,-10.>
+WNDP==.LVAL1
+
+.LOP <ASH @> FRONT <,-10.>
+FRNP==.LVAL1
+
+ZZ2==ENDGC-AGCLD
+.LOP <ASH @> ZZ2 <,-10.>
+LENGC==.LVAL1
+
+.LOP <ASH @> LENGC <,10.>
+RLENGC==.LVAL1
+
+.LOP <ASH @> AGCLD <,-10.>
+PAGEGC==.LVAL1
+
+OFFSET 0
+
+LOC GCST
+.LPUR==$.
+
+END
+
projects / pdp10-muddle.git / blobdiff