-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
-