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 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+] 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 ZZ2 <,-10.> SECLEN==.LVAL1 .LOP SECLEN <,10.> RSECLE==.LVAL1 .LOP AGCLD <,-10.> PAGESC==.LVAL1 OFFSET 0 LOC GCST .LPUR==$. END