github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-15 08:03:19 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/mudsys/agc.142

3635 lines
83 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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