--- /dev/null
+
+TITLE SECAGC MUDDLE GARBAGE COLLECTOR FOR MULTI SECTIONS
+
+;SYSTEM WIDE DEFINITIONS GO HERE
+
+RELOCATABLE
+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
+\f
+
+
+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
+]
+
+\f
+
+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
+
+\f; FIRST CREATE INFERIOR TO HOLD NEW PAGES
+
+INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW
+ ADD A,PARNEW
+ ADDI A,1777
+ ANDCMI A,1777 ; EVEN PAGE BOUNDARY
+ 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
+
+
+
+\f
+; 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,]
+
+\f
+; NOW REHASH THE ASSOCIATIONS BASED ON VALUES
+GARZR1: PUSHJ P,REHASH
+
+
+\f;RESTORE AC'S
+TRYCOX: SKIPN GCMONF
+ JRST NOMONO
+ MOVEI B,[ASCIZ /GOUT /]
+ PUSHJ P,MSGTYP
+NOMONO: MOVE PVP,PVSTOR+1
+ IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
+ MOVE AC,AC!STO+1(PVP)
+ TERMIN
+ SKIPN DSTORE
+ SETZM DSTO(PVP)
+ MOVE PVP,PVPSTO+1(PVP)
+
+; CLOSING ROUTINE FOR G-C
+ PUSH P,A ; SAVE AC'C
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+
+ MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS
+ SUB A,GCSTOP
+ ADDM A,NOWFRE
+ PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS
+ MOVE A,CURTP
+ ADDM A,NOWTP
+ MOVE A,CURP
+ ADDM A,NOWP
+
+ PUSHJ P,CTIME
+ FSBR B,GCTIM ; GET TIME ELAPSED
+ MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER
+ SKIPN GCMONF ; SEE IF MONITORING
+ JRST GCCONT
+ PUSHJ P,FIXSEN ; OUTPUT TIME
+ MOVEI A,15 ; OUTPUT C/R LINE-FEED
+ PUSHJ P,IMTYO
+ MOVEI A,12
+ PUSHJ P,IMTYO
+GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE
+ ; SHRINKAGE FOR EXTRA ROOM
+ SKIPE GCDANG
+ MOVE C,[ETPGOO,,ETPMAX]
+ HLRZM C,TPGOOD
+ HRRZM C,TPMAX
+ POP P,D ; RESTORE AC'C
+ POP P,C
+ POP P,B
+ POP P,A
+ MOVE A,GCDANG
+ JUMPE A,AGCWIN ; IF ZERO THE GC WORKED
+ SKIPN GCHAIR ; SEE IF HAIRY GC
+ JRST BTEST
+REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC
+ MOVEM A,GCHAIR
+ SETZM GCDANG
+ MOVE C,[11,,10.] ; REASON FOR GC
+ JRST 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
+
+\f; 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,
+
+
+
+\f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
+; POINT.
+
+FIXSEN: PUSH P,B ; SAVE TIME
+ MOVEI B,[ASCIZ /TIME= /]
+ PUSHJ P,MSGTYP ; PRINT OUT MESSAGE
+ POP P,B ; RESTORE B
+ FMPRI B,(100.0) ; CONVERT TO FIX
+ MULI B,400
+ TSC B,B
+ ASH C,-163.(B)
+ MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
+ PUSH P,C
+ IDIVI C,10. ; START COUNTING
+ JUMPLE C,.+2
+ AOJA A,.-2
+ POP P,C
+ CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER
+ JRST DOT1
+FIXOUT: IDIVI C,10. ; RECOVER NUMBER
+ HRLM D,(P)
+ SKIPE C
+ PUSHJ P,FIXOUT
+ PUSH P,A ; SAVE A
+ CAIN A,2 ; DECIMAL POINT HERE?
+ JRST DOT2
+FIX1: HLRZ A,(P)-1 ; GET NUMBER
+ ADDI A,60 ; MAKE IT A CHARACTER
+ PUSHJ P,IMTYO ; OUT IT GOES
+ 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
+
+
+\f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
+
+PDLCHK: JUMPGE A,CPOPJ
+ HLRE B,A ;GET NEGATIVE COUNT
+ MOVE C,A ;SAVE A COPY OF PDL POINTER
+ SUBI A,-1(B) ;LOCATE DOPE WORD PAIR
+ HRRZS A ; ISOLATE POINTER
+ CAME A,TPGROW ;GROWING?
+ ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
+ MOVMS B
+ CAIN A,2(C)
+ JRST NOFENC
+ SETOM 1(C) ; START FENECE POST
+ CAIN A,3(C)
+ JRST NOFENC
+ MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS
+ HRRI D,2(C)
+ BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS
+
+
+NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE
+ CAMG B,TPMIN
+ JRST MUNGTP ;TOO BIG OR TOO SMALL
+ POPJ P,
+
+MUNGTP: SUB B,TPGOOD ;FIND DELTA TP
+MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED
+ TRNE C,777000 ;SKIP IF NOT
+ POPJ P, ;ASSUME GROWTH GIVEN WILL WIN
+
+ ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS
+ JUMPLE B,MUNGT1
+ CAILE B,377 ; SKIP IF BELOW MAX
+ MOVEI B,377 ; ELSE USE MAX
+ TRO B,400 ;TURN ON SHRINK BIT
+ JRST MUNGT2
+MUNGT1: MOVMS B
+ ANDI B,377
+MUNGT2: DPB B,[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,
+
+
+\f;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS
+; A/ GOODIE TO MARK FROM
+; B/ TYPE OF A (IN RH)
+; C/ TYPE,DATUM PAIR POINTER
+
+MARK2A:
+MARK2: HLRZ B,(C) ;GET TYPE
+MARK1: MOVE A,1(C) ;GET GOODIE
+MARK: 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
+
+
+\f; 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
+
+\f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR
+VECTM2: HLRE B,(C) ;GET TYPE AND MARKING
+ JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST)
+ MOVE A,1(C) ;DATUM TO A
+
+
+VECTM3: PUSHJ P,MARK ;MARK DATUM
+ MOVEM A,1(C) ; IN CASE WAS FIXED
+VECTM4: ADDI C,2
+ JRST VECTM2
+
+UMOVEC: POP P,A
+MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH
+ 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
+
+\f
+; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN
+; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL.
+
+TPMK1:
+TPMK2: POP P,A ; 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
+\f
+; 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,
+
+\f; 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,
+
+
+\f; MARK TB POINTERS
+TBMK: HRRZS A ; CHECK FOR NIL POINTER
+ SKIPN A
+ JRST GCRET ; IF POINTING TO NIL THEN RETURN
+ HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER
+ HRRZ C,TPSAV(A) ; GET TO DOPE WORD
+TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD
+ HRRZ A,(P) ; GET PTR TO FRAME
+ SUB A,C ; GET PTR TO FRAME
+ HRLS A
+ HRR A,(P)
+ 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
+
+\f
+; MARK ARG POINTERS
+
+ARGMK: HRRZ A,1(C) ; GET POINTER
+ HLRE B,1(C) ; AND LNTH
+ SUB A,B ; POINT TO BASE
+ CAIL A,STOSTR ; CHECK IN VECTOR SPACE
+ CAMLE A,GCSTOP
+ JRST ARGMK0
+ HLRZ 0,(A) ; GET TYPE
+ ANDI 0,TYPMSK
+ CAIN 0,TCBLK
+ JRST ARGMK1
+ CAIE 0,TENTRY ; IS NEXT A WINNER?
+ CAIN 0,TINFO
+ JRST ARGMK1 ; YES, GO ON TO WIN CODE
+
+ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL
+ SETZM (P) ; AND SAVED COPY
+ JRST GCRET
+
+ARGMK1: MOVE B,1(A) ; ASSUME TTB
+ ADDI B,(A) ; POINT TO FRAME
+ CAIE 0,TINFO ; IS IT?
+ MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE
+ HLRZ 0,OTBSAV(B) ; GET TIME
+ HRRZ A,(C) ; AND FROM POINTER
+ CAIE 0,(A) ; SKIP IF WINNER
+ JRST ARGMK0
+ MOVE A,TPSAV(B) ; GET A RELATAVIZED TP
+ HRROI C,TPSAV-1(B)
+ MOVEI B,TTP
+ PUSHJ P,MARK1
+ SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS
+ HRRZ B,(P)
+ ADD B,A
+ HRRM B,(P) ; PUT RELATAVIZED PTR BACK
+ JRST GCRET
+
+\f
+; MARK FRAME POINTERS
+
+FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR
+ HLRZ 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
+
+\f
+; 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
+\f
+
+; 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
+\f
+
+; MARK ATOMS IN GVAL STACK
+
+GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL
+ JUMPE B,ATOMK
+ CAIN B,-1
+ JRST ATOMK
+ MOVEI A,(B) ; POINT TO DECL FOR MARK
+ MOVEI B,TLIST
+ MOVEI C,0
+ PUSHJ P,MARK
+ 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,
+\f
+GETLNT: HLRE B,A ;GET -LNTH
+ SUB A,B ;POINT TO 1ST DOPE WORD
+ MOVEI A,1(A) ;POINT TO 2ND DOPE WORD
+ CAIL A,STOSTR ; CHECK IN VECTOR SPACE
+ CAMLE A,GCSTOP
+ JRST VECTB1 ;BAD VECTOR, COMPLAIN
+ HLRE B,(A) ;GET LENGTH AND MARKING
+ IORM D,(A) ;MAKE SURE MARKED
+ JUMPL B,AMTKE
+ MOVEI 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
+
+
+\f
+; MARK NON-GENERAL VECTORS
+
+NOTGEN: CAMN B,[GENERAL+<SPVP,,0>]
+ JRST GENRAL ;YES, MARK AS A VECTOR
+ JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK
+ SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR
+ HLRZS B ;ISOLATE TYPE
+ ANDI B,TYPMSK
+ 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
+
+
+\f
+; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
+; AND UPDATES PTR TO THE TABLE.
+
+GCRDMK: PUSH P,A ; SAVE PTR TO TOP
+ MOVEI 0,(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
+
+\f
+;MARK RELATAVIZED GLOC HACKS
+
+LOCRMK: SKIPE GCHAIR
+ JRST GCRET
+LOCRDP: PUSH P,C ; SAVE C
+ MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM
+ ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM
+ MOVEI B,TATOM ; ITS AN ATOM
+ SKIPL (C)
+ PUSHJ P,MARK1
+ POP P,C ; RESTORE C
+ MOVE A,1(C) ; GET RELATIVIZATION
+ MOVEM A,(P) ; IT STAYS THE SAVE
+ JRST GCRET
+
+;MARK LOCID TYPE GOODIES
+
+LOCMK: HRRZ B,(C) ;GET TIME
+ JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL
+ HRRZ 0,2(A) ; GET OTHER TIME
+ CAIE 0,(B) ; SAME?
+ SETZB A,(P) ; NO, SMASH LOCATIVE
+ JUMPE A,GCRET ; LEAVE IF DONE
+LOCMK1: PUSH P,C
+ MOVEI B,TATOM ; MARK ATOM
+ MOVEI C,-2(A) ; POINT TO ATOM
+ MOVE E,(C) ; SEE IF BLOCK IS MARKED
+ TLNE E,400000 ; SKIP IF MARKED
+ JRST LOCMK2 ; SKIP OVER BLOCK
+ SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED)
+ PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM
+LOCMK2: POP P,C
+ HRRZ E,(C) ; TIME BACK
+ MOVEI B,TVEC ; ASSUME GLOBAL
+ SKIPE E
+ MOVEI B,TTP ; ITS LOCAL
+ PUSHJ P,MARK1 ; MARK IT
+ MOVEM A,(P)
+ JRST GCRET
+
+\f
+; MARK ASSOCIATION BLOCKS
+
+ASMRK: PUSH P,A
+ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER
+ PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
+ JRST ASTREL ; ALREADY MARKED
+ MOVEI C,-ASOLNT-1(A) ;COPY POINTER
+ PUSHJ P,MARK2 ;MARK ITEM CELL
+ MOVEM A,1(C)
+ ADDI C,INDIC-ITEM ;POINT TO INDICATOR
+ PUSHJ P,MARK2
+ MOVEM A,1(C)
+ ADDI C,VAL-INDIC
+ PUSHJ P,MARK2
+ MOVEM A,1(C)
+ SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS
+ JRST ASTREL
+ HRRZ A,NODPNT-VAL(C) ; NEXT
+ JUMPN A,ASMRK1 ; IF EXISTS, GO
+ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION
+ MOVEI A,ASOLNT+1(A) ; POINT TO D.W.
+ SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR
+ JRST ASTX ; JUMP TO SEND OUT
+ASTR1: HRRZ E,(A) ; RELATAVIZE
+ SUBI E,(A)
+ ADDM E,(P)
+ JRST GCRET ; EXIT
+ASTX: HRRZ 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
+
+
+\f; 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
+
+
+\f
+; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES
+
+ MOVE A,GCGBSP ; GET GLOBAL PDL
+
+GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED
+ JRST SVDCL
+ MOVSI B,-3
+ PUSHJ P,ZERSLT ; CLOBBER THE SLOT
+ HLLZS (A)
+SVDCL: ANDCAM D,(A) ; UNMARK
+ ADD A,[4,,4]
+ JUMPL A,GLOFLS ; MORE?, KEEP LOOPING
+
+ MOVEM LPVP,(P)
+LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS
+ HRRZ C,2(LPVP)
+ MOVEI LPVP,(C)
+ JUMPE A,LOCFL2 ; NONE TO FLUSH
+
+LOCFLS: SKIPGE (A) ; MARKDE?
+ JRST .+3
+ MOVSI B,-5
+ PUSHJ P,ZERSLT
+ ANDCAM D,(A) ;UNMARK
+ HRRZ A,(A) ; GO ON
+ JUMPN A,LOCFLS
+LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS
+
+; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT.
+; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING.
+; IT FIXES UP THE SP-CHAIN AND IT
+; SENDS OUT THE ATOMS.
+
+LOCFL3: MOVE C,(P)
+ MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS
+ PUSHJ P,MARK1 ; MARK THE ATOM
+ MOVEM A,1(C) ; NEW HOME
+ MOVEI C,2(C) ; MARK VALUE
+ MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER
+ PUSHJ P,MARK1 ; MARK IT
+ MOVEM A,1(C)
+ POP P,R
+NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT
+ HLRZ A,2(R) ; GET PTR TO NEXT PROCESS
+ HRLM 0,2(R)
+ HRRZ E,(A) ; ADRESS IN INF
+ HRRZ B,(A) ; CALCULATE RELOCATION
+ SUB B,A
+ PUSH P,B
+ HRRZ 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
+
+\f; 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
+
+\f;SUBROUTINE TO SEE IF A GOODIE IS MARKED
+;RECEIVES POINTER IN C
+;SKIPS IF MARKED NOT OTHERWISE
+
+MARKQ: HLRZ B,(C) ;TYPE TO B
+MARKQ1: MOVE E,1(C) ;DATUM TO C
+ MOVEI 0,(E)
+ CAIL 0,@PURBOT ; DONT CHACK PURE
+ JRST MKD ; ALWAYS MARKED
+ ANDI B,TYPMSK ; FLUSH MONITORS
+ LSH B,1
+ HRRZ B,@TYPNT ;GOBBLE SAT
+ ANDI B,SATMSK
+ CAIG B,NUMSAT ; SKIP FOR TEMPLATE
+ JRST @MQTBS(B) ;DISPATCH
+ ANDI E,-1 ; FLUSH REST HACKS
+ JRST VECMQ
+
+
+MQTBS:
+
+OFFSET 0
+
+DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
+[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ]
+[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]
+[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ]
+[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]]
+
+OFFSET OFFS
+
+PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED
+ SKIPL (E) ; SKIP IF MARKED
+ POPJ P,
+ARGMQ:
+MKD: AOS (P)
+ POPJ P,
+
+BYTMQ: PUSH P,A ; SAVE A
+ PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD
+ MOVE E,A ; COPY POINTER
+ POP P,A ; RESTORE A
+ SKIPGE (E) ; SKIP IF NOT MARKED
+ AOS (P)
+ POPJ P, ; EXIT
+
+FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD
+ SOJA E,VECMQ1
+
+ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS
+ JRST VECMQ
+ AOS (P)
+ POPJ P,
+
+VECMQ: HLRE 0,E ;GET LENGTH
+ SUB E,0 ;POINT TO DOPE WORDS
+
+VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED
+ AOS (P) ;MARKED, CAUSE SKIP RETURN
+ POPJ P,
+
+ASMQ: 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,
+
+\f; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF
+
+ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN
+ASSOP1: HRRZ B,NODPNT(A)
+ PUSH P,B ; SAVE NEXT ON CHAIN
+ PUSH P,A ; SAVE IT
+ HRRZ B,ASOLNT-1(A) ;POINT TO NEXT
+ JUMPE B,ASOUP1
+ HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C
+ SUBI C,ASOLNT+1(B) ; RELATIVIZE
+ ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER
+ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER
+ JUMPE B,ASOUP2
+ HRRZ 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
+
+\f
+; HERE TO CLEAN UP ATOM HASH TABLE
+
+ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER
+
+ATCLE1: MOVEI B,0
+ SKIPE C,(A) ; GET NEXT
+ JRST ATCLE2 ; GOT ONE
+
+ATCLE3: PUSHJ P,OUTATM
+ AOBJN A,ATCLE1
+
+ MOVE A,GCHSHT ; MOVE OUT TABLE
+ PUSHJ P,SPCOUT
+ POPJ P,
+
+; HAVE AN ATOM IN C
+
+ATCLE2: MOVEI B,0
+
+ATCLE5: CAIL C,HIBOT
+ JRST ATCLE3
+ CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED
+ JRST .+3
+ SKIPL 1(C) ; SKIP IF ATOM MARKED
+ JRST ATCLE6
+
+ HRRZ 0,1(C) ; GET DESTINATION
+ CAIN 0,-1 ; FROZEN/MAGIC ATOM
+ MOVEI 0,1(C) ; USE CURRENT POSN
+ SUBI 0,1 ; POINT TO CORRECT DOPE
+ JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM
+
+ HRRZM 0,(A) ; INTO HASH TABLE
+ JRST ATCLE8
+
+ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM
+ PUSHJ P,OUTATM
+
+ATCLE8: HLRZ B,1(C)
+ ANDI B,377777 ; KILL MARK BIT
+ SUBI B,2
+ HRLI B,(B)
+ SUBM C,B
+ HLRZ C,2(B)
+ JUMPE C,ATCLE3 ; DONE WITH BUCKET
+ JRST ATCLE5
+
+; HERE TO PASS OVER LOST ATOM
+
+ATCLE6: HLRZ 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,
+
+\f
+VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH
+
+
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
+
+MSGGCT: [ASCIZ /USER CALLED- /]
+ [ASCIZ /FREE STORAGE- /]
+ [ASCIZ /TP-STACK- /]
+ [ASCIZ /TOP-LEVEL LOCALS- /]
+ [ASCIZ /GLOBAL VALUES- /]
+ [ASCIZ /TYPES- /]
+ [ASCIZ /STATIONARY IMPURE STORAGE- /]
+ [ASCIZ /P-STACK /]
+ [ASCIZ /BOTH STACKS BLOWN- /]
+ [ASCIZ /PURE STORAGE- /]
+ [ASCIZ /GC-RCALL- /]
+
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
+
+GCPAT: SPBLOK 100
+EGCPAT: -1
+%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
+
+\f
+;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
+
projects / pdp10-muddle.git / blobdiff