github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-21 10:13:35 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/mudsys/secagc.82
Lars Brinkhoff 7ab2f2a441 Increase symbol table size for some files.
2018-04-25 09:32:25 +01:00

2294 lines
52 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 SECAGC MUDDLE GARBAGE COLLECTOR FOR MULTI SECTIONS
;SYSTEM WIDE DEFINITIONS GO HERE
RELOCATABLE
.SYMTAB 3337.
GCST==$.
TOPGRO==111100
BOTGRO==001100
MFORK==400000
.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
.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,%SLEEP,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
.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR
.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 ISECGC,SECLEN,RSECLE
.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10
.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC
.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG
.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET
.GLOBAL INBLOT,RSLENG
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
GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR
STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT
STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT
LOC REALGC+RLENGC+RSLENG
OFFS==AGCLD-$.
OFFSET OFFS
.INSRT MUDDLE >
.INSRT STENEX >
PGSZ==9.
F==E+1 ; THESE 3 ACS OFTEN USED FOR XBLT
G==F+1
FPTR==G+1
TYPNT==FPTR+1 ; SPECIAL AC USAGE DURING GC
EXTAC==TYPNT+1 ; ALSO SPECIAL DURING GC
LPVP==EXTAC+1 ; SPECIAL FOR GC, HOLDS POINTER TO PROCESS
; CHAIN
.LIST.==400000
.GLOBAL %FXUPS,%FXEND
DEFINE DOMULT INS
FOOIT [INS]
TERMIN
DEFINE FOOIT INS,\LCN
LCN==.-OFFS
INS
RMT [
TBLADD LCN
]
TERMIN
RMT [%FXLIN==0
]
DEFINE TBLADD LCN,\FOO
FOO==.-OFFS
%FXLIN,,LCN
%FXLIN==FOO
%FXUPS==FOO
TERMIN
RMT [XBLT==123000,,%XXBLT
]
ISECGC:
;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 /SGIN /]
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: ADJSP P,-1 ; POP OFF C
POP P,A
POP P,B
EXCH P,GCPDL
HLLZS SQUPNT ; FLUSH SQUOZE TABLE
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,400000+B ; LOCAL INDEX
CHPDL: MOVE D,P ; SAVE FOR LATER
CORGET: MOVE P,[GCSEG,,MRKPDL] ; USE GCSEG FOR PDL
;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
HRRZ 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
MOVEM A,NPARBO
MOVE FPTR,A
HRLI FPTR,GCSEG
; NOW ZERO OUT NEW SPACE USING XBLT
; DOMULT [SETZM (FPTR)]
; MOVEI 0,777777-1
; SUBI 0,(FPTR) ; FROM VECBOT UP
; MOVE A,FPTR
; MOVE B,A
; ADDI B,1
; DOMULT [XBLT 0,]
; USE PMAP TO FLUSH GC SPACE PAGES
MOVNI A,1
MOVE B,[MFORK,,GCSEG_9.]
MOVE C,[SETZ 777]
PMAP
;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
; MOVE NEW GC SPACE IN
NOMAP1: MOVE A,P.TOP
SUBI A,1
MOVE C,PARBOT
MOVE B,C
SUB A,B
HRLI B,GCSEG
DOMULT [XBLT A,]
; 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 ISECGC
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 ; IF LOADING ONE, IT MIGHT NOT HAVE ARRIVED
JRST FINAGC
FATAL AGC--RUNNING RSUBR WENT AWAY
AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR
; CORE ADJUSTMENT PHASE
CORADJ: MOVE A,PURTOP
SUB A,CURPLN ; ADJUST FOR RSUBR
MOVEM A,RPTOP
HRRZ A,FPTR ; 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
HRRZ A,FPTR ; GCSTOP
MOVEM A,GCSTOP
MOVE A,CORTOP ; ADJUST CORE IMAGE
ASH A,-10. ; TO PAGES
TRYPCO: PUSHJ P,P.CORE
FATAL NO CORE?
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
HRRZ A,FPTR
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
MOVEM A,CORTOP ; ADJUST PARAMETER
JRST CORAD6 ; WIN TOTALLY
CORAD8: MOVEM A,CORTOP ; NEW CORTOP
JRST CORAD6
; 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,
; 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
MOVEI A,FSEG
HRLM A,-1(P)
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,[TOPGRO,,-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 EXTAC,1(A) ; GET LNTH
LDB 0,[TOPGRO,,(A)] ; GET GROWTHS
TRZE 0,400 ; SIGN HACK
MOVNS 0
ASH 0,6 ; TO WORDS
ADD EXTAC,0
LDB 0,[BOTGRO,,(A)]
TRZE 0,400
MOVNS 0
ASH 0,6
ADD EXTAC,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: JUMPE A,CPOPJ ; NEVER MARK 0
MOVEI 0,1(A)
CAML 0,PURBOT
JRST GCRETD
MARCON: PUSH P,C
PUSH P,A
ANDI B,TYPMSK ; FLUSH MONITORS
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
JRST @SMKTBS(B)
SMKTBS:
OFFSET 0
TBLDIS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK]
[STPSTK,TPMK],[SARGS,ARGMK],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
[SFRAME,FRMK],[SBYTE,BYTMK],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
[SLOCID,LOCMK],[SCHSTR,BYTMK],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
[SLOCA,ARGMK],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,BYTMK],[SLOCN,ASMRK]
[SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,BYTMK],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]]NUMSAT,400000
OFFSET OFFS
; 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: SETOM GENFLG ; SET FLAG SAYING DEFERRED
CAIA
;HERE TO MARK LIST ELEMENTS
PAIRMK: SETZM GENFLG ;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
DOMULT [MOVEM B,(FPTR)]
MOVE 0,1(C) ; AND 2D
DOMULT [MOVEM 0,1(FPTR)]
ADDI FPTR,2 ; MOVE ALONG IN NEW SPACE
PAIRM2: MOVEI A,-2(FPTR) ; GET INF ADDR
HRRM A,(C) ; LEAVE A POINTER TO NEW HOME
HRRZ E,(P) ; GET BACK POINTER
JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP
HRLI E,GCSEG
DOMULT [HRRM A,(E)] ; CLOBBER
PAIRM4: MOVEM A,(P) ; NEW BACK POINTER
SKIPGE GENFLG
JRST 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
HRLI E,GCSEG
DOMULT [MOVEM A,1(E)]
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: ADJSP P,-1
GCRET: SETZM GENFLG ;FOR PAIRMKS BENEFIT
POP P,A ;RESTORE C AND A
POP P,C
POPJ P, ;AND RETURN TO CALLER
GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS
CAIN B,TLOCR ; SEE IF A LOCR
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
HRLI C,GCSEG ; KEEP IN CORRECT SECTION
PUSHJ P,MARK2 ;MARK THE DATUM
HRRZ E,-2(P) ; GET POINTER IN INF CORE
HRLI E,GCSEG
DOMULT [MOVEM A,1(E)]
MOVE A,-1(P)
DOMULT [HRRM A,(E)]
ADJSP P,-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
HRLI E,GCSEG
DOMULT [HRRM A,(E)]
JRST GCRETP
RETNW1: MOVEM A,-1(P)
JRST GCRETP
; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
TPMK: SETOM GENFLG ;SET TP MARK FLAG
CAIA
VECTMK: SETZM GENFLG
PUSH P,FPTR
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
MOVE 0,GENFLG
HLLM 0,(P) ; SAVE TP VS VECT INDICATOR
JUMPE 0,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,[TOPGRO,,-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,[BOTGRO,,-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 EXTAC,(E) ;SAVE A COPY
ADD EXTAC,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
MOVE EXTAC,GENFLG
SKIPGE B,-1(A) ;SKIP IF UNIFORM
TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL
JUMPE EXTAC,NOTGEN ;JUMP IF NOT A GENERAL VECTOR
GENRAL: HLRZ 0,B ;CHECK FOR PSTACK
TRZ 0,.VECT.
JUMPE 0,NOTGEN ;IT ISN'T GENERAL
JUMPN EXTAC,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
CAMGE A,GCSBOT ; DONT DO THIS STUFF IF THIS IS FROZEN
JRST EXVEC1
HRRZ B,-1(P) ; GET POINTER INTO INF
JUMPLE C,MOVEC3
ADD B,C ; GROW IT
MOVEC3: HLLZ 0,-1(A) ; MODIFY DOPE WORD AND PLACE IN INF
TLO 0,.VECT.
HRRZ EXTAC,(A) ; DESTINATION OF DOPEWORDS (SORT OF)
HRLI EXTAC,GCSEG ; MAKE INTO CORRECT KIND OF ADDR
DOMULT [MOVEM 0,-1(EXTAC)]
HLRZ 0,(A)
ANDI 0,377777 ; KILL MARK BIT
SKIPG C
ADD 0,C ; COMPENSATE FOR SHRINKAGE
MOVE EXTAC,A
SUB A,0
ADDI A,1
SKIPGE (P) ; ACCOUNT FOR OTHER END SHRINKAGE
ADD 0,(P)
HRLI B,GCSEG
SUBI 0,2 ; AVOID RE-SENDING DOPE WORDS
DOMULT [XBLT 0,] ; MOVE VECTOR TO OTHER IMAGE
MOVE A,EXTAC
EXVEC1: ADJSP P,-1
EXVECT: HLRZ B,(P)
ADJSP P,-1 ; GET RID OF FPTR
PUSHJ P,RELATE ; RELATIVIZE
JUMPE B,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 ; RESTORE DW POINTER
POP P,C ; AND BOTTOM GROWTH
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
HRLI E,GCSEG
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)
AOS E,-1(P) ; MOVE OUT TYPE
DOMULT [MOVEM A,-1(E)]
DOMULT [MOVEM R,(E)]
AOS -1(P)
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)
MOVE E,-1(P)
DOMULT [MOVEM A,(E)]
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)
DOMULT [MOVEM A,1(E)]
MOVE A,-2(P) ; ADJUST AB SLOT
ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB
DOMULT [MOVEM A,2(E)]
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
DOMULT [MOVEM A,3(E)]
HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P
MOVEI B,TPDL
ADDI E,FRAMLN ; UPDATE OUT ADDR
MOVEM E,-1(P)
PUSHJ P,MARK1 ;AND MARK IT
MOVE E,-1(P)
DOMULT [MOVEM A,-3(E)] ; STORE UPDATED P
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
DOMULT [MOVEM A,-2(E)] ; AND UPDATED TP
MOVE A,PCSAV-PSAV+1(C)
DOMULT [MOVEM A,-1(E)] ; DONT FORGET SAVED PC
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)
AOS E,-1(P) ; FIX UP CHAIN
DOMULT [MOVEM A,-1(E)]
MOVEI B,TATOM ; RESTORE IN CASE SMASHED
PUSHJ P,MARK1 ; MARK ATOM
AOS E,-1(P) ; SEND IT OUT
DOMULT [MOVEM A,-1(E)]
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)
AOS E,-1(P) ; SEND IT OUT
DOMULT [MOVEM A,-1(E)]
MOVE A,R
DOMULT [MOVEM A,(E)] ; SEND OUT VALUE
AOS -1(P)
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
AOS E,-1(P) ; SEND IT OUT
DOMULT [MOVEM A,-1(E)]
SKIPL A,1(C) ; PREV LOC?
JRST NOTLCI
MOVEI B,TLOCI ; NOW MARK LOCATIVE
PUSHJ P,MARK1
NOTLCI: AOS E,-1(P) ; SEND IT OUT
DOMULT [MOVEM A,-1(E)]
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
AOS E,-1(P) ; SEND IT OUT
DOMULT [MOVEM A,-1(E)]
ADDI C,1 ; INCREMENT C FOR FENCE-POST
ADJSP P,-1 ; CLEAN UP STACK
POP P,E ; GET UPDATED PTR TO INF
ADJSP P,-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
HLLZ 0,-1(A) ; MODIFY DOPE WORD AND PLACE IN INF
TLO 0,.VECT.
HRRZ EXTAC,(A) ; DESTINATION OF DOPEWORDS (SORT OF)
HRLI EXTAC,GCSEG ; MAKE INTO CORRECT KIND OF ADDR
DOMULT [MOVEM 0,-1(EXTAC)]
JRST EXVECT
; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR
; EXTAC= # OF WORDS TO ALLOCATE
ALLOGC: HRRZS A ; GET ABS VALUE
CAML A,GCSBOT ; SKIP IF IN STORAGE
JRST ALOGC2 ; JUMP IF ALLOCATING
HRRZ 0,A
POPJ P,
ALOGC2:
ALOGC1: ADDI FPTR,(EXTAC)
MOVEI 0,-1(FPTR)
DOMULT [HRRM 0,-1(FPTR)]
DOMULT [HRLM EXTAC,-1(FPTR)]
POPJ P,
; RELATE RELATAVIZES A POINTER TO A VECTOR
; B IS THE POINTER A==> DOPE WORD
RELATE: CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE
POPJ P, ; IF NOT EXIT
MOVE C,-1(P)
HLRE EXTAC,C ; GET LENGTH
HRRZ 0,-1(A) ; CHECK FO GROWTH
JUMPE A,RELAT1
LDB 0,[TOPGRO,,-1(A)] ; GET TOP GROWTH
TRZE 0,400 ; HACK SIGN BIT
MOVNS 0
ASH 0,6 ; CONVERT TO WORDS
SUB EXTAC,0 ; ACCOUNT FOR GROWTH
RELAT1: HRLM EXTAC,C ; PLACE CORRECTED LENGTH BACK IN POINTER
HRRZ EXTAC,(A) ; GET RELOCATED ADDR
SUBI EXTAC,(A) ; FIND RELATIVIZATION AMOUNT
ADD C,EXTAC ; 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)
MOVE C,P
PUSH P,A
MOVEI B,TTP
PUSHJ P,MARK
ADJSP P,-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 EXTAC,OTBSAV(A) ; GET TIME FROM FRAME
CAME B,EXTAC ; 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 EXTAC,-1(A) ; GET THE TYPE
ANDI EXTAC,SATMSK ; FLUSH MONITOR BITS
CAIN EXTAC,SATOM ; SEE IF ATOM
JRST ATMSET
HLRE EXTAC,(A) ; GET MARKING
JUMPL EXTAC,BYTREL ; JUMP IF MARKED
HLRZ EXTAC,(A) ; GET LENGTH
PUSHJ P,ALLOGC ; ALLOCATE FOR IT
HRRM 0,(A) ; SMASH IT IN
MOVE B,0
HLRZ 0,(A)
SUBI 0,1 ; DONT RESEND DW
SUBI B,-1(EXTAC) ; ADJUST INF POINTER
MOVE E,A
SUBI A,-1(EXTAC)
HRLI B,GCSEG
DOMULT [XBLT 0,]
IORM D,(E)
MOVE A,E
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
JRST BYTREL ; TO BYTREL
; MARK OFFSET
OFFSMK: HLRZS A
PUSH P,$TLIST
MOVE C,P
PUSH P,A ; PUSH LIST POINTER ON THE STACK
PUSHJ P,MARK2 ; MARK THE LIST
HRLM A,-2(P) ; UPDATE POINTER IN OFFSET
ADJSP P,-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
MOVE 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,(FPTR)
PUSH P,0 ; SAVE POINTER TO INF
SETOM .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) ; CHECK IF NOT ON ANY OBLIST
POP P,B ; RESTORE A
POP P,C ; GET POINTER INTO INF
MOVE A,B
SKIPN GCHAIR
JUMPN 0,ATMREL ; ALWAYS SEND OUT ATOMS ON NO OBLIST
; HERE WITH B POINT TO CURRENT DW AND C TO NEW DW, DO IT TO IT
ATMOVX: PUSHJ P,XBLTR
ATMREL: HRRZ E,(A) ; RELATAVIZE
SUBI E,(A)
ADDM E,(P)
JRST GCRET
ATMRL1: ADJSP P,-1 ; POP OFF STACK
JRST ATMREL
; HERE TO MOVE STUFF TO OTHER SEGMENT
; B==> CURRENT DW, C==> START OF NEW OBJECT (A MUST SURVIVE)
XBLTR: CAMGE B,GCSBOT
POPJ P,
MOVE EXTAC,A
HRRZ E,(B) ; NEW DW LOC
HRLI E,GCSEG
DOMULT [HLRZ A,(E)]
SUBI A,1
SUBI B,(A)
HRLI C,GCSEG
DOMULT [XBLT A,]
MOVE A,EXTAC ; BACK TO A
POPJ P,
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 EXTAC,(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: ADJSP P,-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
MOVE EXTAC,B ; AND COPY IT
LSH B,1 ;FIND OUT WHERE IT WILL GO
HRRZ B,@TYPNT ;GET SAT IN B
ANDI B,SATMSK
HRRZ C,SMKTBS(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,EXTAC ;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
ADJSP P,-2 ;REMOVE STACK CRAP
JRST UMOVEC
SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR
ADJSP P,-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,(FPTR) ; 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,B ; GET PTR TO D.W.
POP P,C ; GET PTR TO INF
ADJSP P,-1 ; GET RID OF TOP
MOVE A,B
JRST ATMOVX ; RELATIVIZE AND LEAVE
GCRDRL: POP P,A ; GET PTR TO D.W
ADJSP P,-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
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 C,(A) ; GET PTR IN FRONTEIR
SUBI C,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING
MOVE B,A
PUSHJ P,XBLTR
JRST ASTR1
;HERE WHEN A VECTOR POINTER IS BAD
VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE
ADJSP P,-1 ; RECOVERY
AFIXUP: SETZM (P) ; CLOBBER SLOT
JRST GCRET ; CONTINUE
VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE
ADJSP P,-2
JRST AFIXUP ; RECOVER
PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE
ADJSP P,-1 ; RECOVER
JRST AFIXUP
; HERE TO MARK TEMPLATE DATA STRUCTURES
TD.MRK: MOVEI 0,(FPTR) ; 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 B,-7(P) ; RESTORE PTR TO FRONTEIR
ADJSP P,-7 ; CLEAN UP STACK
USRAG1: ADDI A,1 ; POINT TO SECOND D.W.
MOVSI D,400000 ; SET UP MARK BIT
MOVE B,A
HRRZ C,(A) ; DEST DW
DOMULT [HLRZ E,(C)] ; LENGTH
SUBI C,-1(E)
PUSHJ P,XBLTR
TMPREL: ADJSP P,-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 B,(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 EXTAC,(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 EXTAC,(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,EXTAC
HLRE EXTAC,ASOLNT-INDIC+1(C) ; GET LENGTH
JUMPL EXTAC,.+3 ; SKIP IF MARKED
CAMGE C,VECBOT ; SKIP IF IN VECT SPACE
JRST ASOM20
HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION
MOVEI EXTAC,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,EXTAC
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(EXTAC) ; 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
MOVE 0,.ATOM.
SETZM .ATOM.
JUMPN 0,VALFLA ; YES, CHECK VALUES
VALFL8:
; NOW SEE WHICH CHANNELS STILL POINTED TO
CHNFL3: MOVEI 0,N.CHNS-1
MOVEI A,CHNL1 ; SLOTS
HRLI E,TCHAN ; TYPE HERE TOO
CHNFL2: SKIPN B,1(A)
JRST CHNFL1
HLRE C,B
SUBI B,(C) ; POINT TO DOPE
HLLM E,(A) ; PUT TYPE BACK
HRRE EXTAC,(A) ; SEE IF ALREADY MARKED
JUMPN EXTAC,CHNFL1
SKIPGE 1(B)
JRST CHNFL8
HLLOS (A) ; MARK AS A LOSER
SETZM -1(P)
JRST CHNFL1
CHNFL8: MOVEI EXTAC,1 ; MARK A GOOD CHANNEL
HRRM EXTAC,(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
ADJSP P,-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 EXTAC,A ; CALCULATE START OF TP IN EXTAC
HLRZ B,(A) ; ADJUST INF PTR
TRZ B,400000
SUBI EXTAC,-1(B)
LDB M,[TOPGRO,,-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: ADJSP P,-1 ; CLEAN UP STACK
SUBI E,-1(B)
MOVEI A,6(R) ; POINT AFTER THE BINDING
MOVE 0,EXTAC ; CALCULATE # OF WORDS TO SEND OUT
SUBM A,0
HRRZ A,EXTAC
MOVE B,E
HRLI B,GCSEG
DOMULT [XBLT 0,]
HRRZS R,2(R) ; GET THE NEXT PROCESS
JUMPE R,.+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 E,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 STUFF - SPCOUX--DONT LOOK AT GROWTH
; SPCOUT--LOOK AT GROWTH
SPCOUX: TDZA C,C ; ZERO C AS FLAG
SPCOUT: MOVEI C,1
HLRE B,A
SUB A,B
MOVEI A,1(A) ; POINT TO DOPE WORD
CAMGE A,GCSBOT
POPJ P,
HLLZ 0,-1(A) ; MODIFY DOPE WORD AND PLACE IN INF
TLO 0,.VECT.
HRRZ B,(A) ; DESTINATION OF DOPEWORDS (SORT OF)
HRLI B,GCSEG ; MAKE INTO CORRECT KIND OF ADDR
DOMULT [MOVEM 0,-1(B)]
JUMPE C,SPCOUY ; JUMP IF NO GROWTH STUFF
LDB C,[BOTGRO,,-1(A)]
TRZE C,400
MOVNS C
ASH C,6
SPCOUY: DOMULT [HLRZ 0,(B)]
ADD 0,C ; COMPENSATE FOR SHRINKAGE
SUBI 0,1 ; DONT RESEND DW
SUB A,0
SUB B,0
DOMULT [XBLT 0,] ; MOVE VECTOR TO OTHER IMAGE
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,EXTAC
PUSHJ P,MARK2
MOVEM A,1(C)
POP P,EXTAC
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
ADJSP P,-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: SUBI 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 EXTAC,ASOLNT+1(B) ;AND ITS RELOCATION
SUBI EXTAC,ASOLNT+1(B) ; RELATIVIZE
MOVSI EXTAC,(EXTAC)
ADDM EXTAC,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 EXTAC,ASOLNT+1(B) ;RELOC
SUBI EXTAC,ASOLNT+1(B)
MOVSI EXTAC,(EXTAC)
ADDM EXTAC,NODPNT(A)
ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD
MOVEI A,ASOLNT(A)
PUSHJ P,SPCOUX
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 EXTAC,1(C) ; FIND NEXT ATOM
SUBI C,-2(EXTAC)
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
ANDI A,-1
PUSHJ P,SPCOUX
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
%XXBLT: 020000,,
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
;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
;AND WHEN IT WILL GET UNHAPPY
;IN GC FLAG
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
NPARBO: 0 ; SAVED PARBOT
; CONSTANTS FOR DUMPER,READER AND PURIFYER
GENFLG: 0
.ATOM.: 0
; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR
PURE
OFFSET OFFS
CONSTANTS
HERE
DEFINE HERE G00002,G00003
G00002!G00003!TERMIN
CONSTANTS
OFFSET 0
ZZ==$.+1777
.LOP ANDCM ZZ 1777
ZZ1==.LVAL1
LOC ZZ1
OFFSET OFFS
MRKPD: SPBLOK 1777
ENDPDL: -1
MRKPDL=MRKPD-1
SENDGC:
OFFSET 0
ZZ2==SENDGC-AGCLD
.LOP <ASH @> ZZ2 <,-10.>
SECLEN==.LVAL1
.LOP <ASH @> SECLEN <,10.>
RSECLE==.LVAL1
.LOP <ASH @> AGCLD <,-10.>
PAGESC==.LVAL1
OFFSET 0
LOC GCST
.LPUR==$.
END
Reference in New Issue View Git Blame Copy Permalink