TITLE UTILITY FUNCTIONS FOR MUDDLE RELOCATABLE .INSRT MUDDLE > SYSQ IFE ITS,[ .INSRT STENEX > XJRST==JRST 5, ] .GLOBAL GODUMP,IPURIF,EGCDUM,EPURIF,LODGC,KILGC,CALER,RBLDM,CPOPJ,C1POPJ,INQAGC,FRETOP .GLOBAL SAT,PGFIND,PGGIVE,PGTAKE,PINIT,ERRKIL,CKPUR,GCSET,MKTBS,PFLG,NPWRIT,GETNUM .GLOBAL AGC,AAGC,%CLSM1,%SHWND,IBLOCK,FINAGC,PGINT,CPOPJ1,REHASH,FRMUNG,MAXLEN,TOTCNT .GLOBAL NWORDT,NWORDS,MSGTYP,IMTYO,MULTSG,MULTI,NOMULT,GCDEBU .GLOBAL PURCOR,INCORF,BADCHN,INTHLD,%MPIN1,WNDP,WIND,ACCESS,PURTOP,GCPDL,CTIME,P.CORE .GLOBAL IAGC,IAAGC,TYPVEC,PURBOT,PURTOP,MOVPUR,PURVEC,PMAPB,CURPLN,RFRETP,NOWFRE,FREMIN .GLOBAL MAXFRE,TPGROW,PDLBUF,CTPMX,PGROW,PDLBUF,CPMX,SAVM,NOWP,NOWTP,MPOPJ,GCFLG,GCDOWN .GLOBAL GCTIM,NOSHUF,P.TOP,GETPAG,ITEM,INDIC,ASOVEC,ASOLNT,GETBUF,KILBUF,PAT,PATEND .GLOBAL PATCH,DSTORE,PVSTOR,SPSTOR,SQKIL,IAMSGC,FNMSGC,RNUMSP,NUMSWP,SWAPGC,SAGC,GCSTOP .GLOBAL ISECGC .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 .GLOBAL C%M20,C%M30,C%M40,C%M60 FPAG==2000 ; GC-DUMP TAKES AN OBJECT AND MAPS IT INTO A FILE DIRECTLY USING THE GARBAGE ; COLLECTOR. ALL OBJECTS HAVE RELATIVIZED POINTERS AND WILL BE SET UP UPON ; READIN (USING GC-READ). ; IT TAKES TWO ARGUMENTS. THE FIRST IS THE OBJECT THE SECOND MUST BE A "PRINTB" ; CHANNEL. MFUNCTION GCDUMP,SUBR,[GC-DUMP] ENTRY IFE ITS,[ PUSH P,MULTSG SKIPE MULTSG ; MUST RUN I 0 SEXTION MODE PUSHJ P,NOMULT ] MOVE PVP,PVSTOR+1 IRP AC,,[FRM,P,R,M,TP,TB,AB] MOVEM AC,AC!STO"+1(PVP) TERMIN SETZM PURCOR SETZM INCORF ; SET UP PARAMS CAML AB,C%M20 ; CHECK ARGS JRST TFA CAMG AB,C%M60 JRST TMA GETYP A,2(AB) ; SEE WHETHER THE CHANNEL IS A WINNER CAIN A,TFALSE ; SKIP IF NOT FALSE JRST UVEARG CAIE A,TCHAN JRST WTYP2 ; ITS NOT A CHANNEL. COMPLAIN MOVE B,3(AB) ; CHECK BITS IN CHANNEL HRRZ C,-2(B) TRC C,C.PRIN+C.OPN+C.BIN TRNE C,C.PRIN+C.OPN+C.BIN JRST BADCHN PUSH P,1(B) ; SAVE CHANNEL NUMBER CAMGE AB,C%M40 ; SEE IF THIRD ARG WAS SNUCK IN JRST TMA JRST IGCDUM UVEARG: SETOM INCORF ; SET UP FLAG INDICATING UVECTOR CAML AB,C%M40 ; SEE IF THIRD ARG JRST IGCDUM GETYP A,5(AB) CAIE A,TFALSE SETOM PURCOR IGCDUM: SETZM SWAPGC PUSHJ P,LODGC ; GET THE GARBAGE COLLECTOR SETOM INTHLD JRST GODUMP EGCDUM: PUSH P,A ; SAVE LENGTH PUSHJ P,KILGC ; KILL THE GARBAGE COLLECTOR POP P,A SETZM INTHLD SKIPN INCORF ; SKIP IF TO UVECTOR JRST OUTFIL SKIPN PURCOR ; SKIP IF PURE UVECTOR JRST BLTGCD ; ROUTINE TO CREATE A UVECTOR IN PURE STORAGE CONTAINING GC-DUMPED ; OBJECTS. ADDI A,1777 ; ROUND ANDCMI A,1777 ASH A,-10. ; TO BLOCKS PUSH P,A ; SAVE IT TRAGN: PUSHJ P,PGFIND ; TRY TO GET PAGES JUMPL B,GCDPLS ; LOSSAGE? POP P,A ; GET # OF PAGES PUSH P,B ; SAVE B MOVNS A ; BUILD AOBJN POINTER HRLZS A ADDI A,FPAG/2000 ; START HLL B,A ; SAME # OF PAGES PUSHJ P,%MPIN1 POP P,B ; RESTORE # OF FIRST PAGE ASH B,10. ; TO ADDRESS POP P,A ; RESTORE LENGTH IN WORDS MOVNI A,-2(A) ; BUILD AOBJN HRL B,A MOVE A,$TUVEC ; TYPE WORD JRST DONDUM ; FINISH ; HERE WHEN EFFORTS TO GE PURE STORAGE FAIL. GCDPLS: MOVE A,(P) ; GET # OF PAGES ASH A,10. ; TO WORDS ADDI A,1777 ANDCMI A,1777 ; ROUND AND TO PAGE MOVEM A,GCDOWN MOVE C,[13.,,9.] ; CAUSE INDICATOR PUSHJ P,AGC ; CAUSE AGC TO HAPPEN MOVE A,(P) ; GET # OF PAGES JRST TRAGN ; TRY AGAIN ; HERE TO TRANSFER FROM INFERIOR TO THE FILE OUTFIL: PUSH P,A ; SAVE LENGTH OF FILE PUSHJ P,SETBUF MOVE A,(P) ANDCMI A,1777 ASH A,-10. ; TO PAGES MOVNS A ; SET UP AOBJN POINTER HRLZS A ADDI A,1 ; STARTS ON PAGE ONE MOVE C,-1(P) ; GET ITS CHANNEL # MOVE B,BUFP ; WINDOW PAGE JUMPGE A,DPGC5 IFN ITS,[ DPGC3: MOVE D,BUFL HRLI D,-2000 ; SET UP BUFFER IOT POINTER PUSHJ P,%SHWND ; SHARE INF PAGE AND WINDOW DOTCAL IOT,[C,D] FATAL GCDUMP-- IOT FAILED AOBJN A,DPGC3 ] IFE ITS,[ DPGC3: MOVE B,BUFP PUSHJ P,%SHWND PUSH P,A ; SAVE A PUSH P,C ; SAVE C MOVE A,C ; CHANNEL INTO A MOVE B,BUFL ; SET UP BYTE POINTER HRLI B,444400 MOVNI C,2000 SOUT ; OUT IT GOES POP P,C POP P,A ; RESTORE A AOBJN A,DPGC3 ] DPGC5: MOVE D,(P) ; CALCULATE AMOUNT LEFT TO SEND OUT MOVE 0,D ANDCMI D,1777 ; TO PAGE BOUNDRY SUB D,0 ; SET UP AOBJN PTR FOR OUTPUT IFN ITS,[ HRLZS D ADD D,BUFL MOVE B,BUFP ; SHARE WINDOW PUSHJ P,%SHWND DOTCAL IOT,[C,D] FATAL GCDUMP-- IOT FAILED ] IFE ITS,[ MOVE B,BUFP ; SET UP WINDOW PUSHJ P,%SHWND MOVE A,C ; CHANNEL TO A MOVE C,D MOVE B,BUFL ; SET UP BYTE POINTER HRLI B,444400 SOUT ] POP P,D MOVE B,3(AB) ; GET CHANNEL ADDM D,ACCESS(B) PUSHJ P,KILBUF MOVE A,(AB) ; RETURN WHAT IS GIVEN MOVE B,1(AB) DONDUM: PUSH TP,A ; SAVE RETURNS PUSH TP,B PUSHJ P,%CLSM1 SUB P,C%11 IFE ITS,[ POP P,MULTSG SKIPE MULTSG PUSHJ P,MULTI ] POP TP,B POP TP,A JRST FINIS ; HERE TO BLT INTO A UVECTOR IN GCS BLTGCD: PUSH P,A ; SAVE # OF WORDS PUSHJ P,SETBUF MOVE A,(P) PUSHJ P,IBLOCK ; GET THE UVECTOR PUSH TP,A ; SAVE POINTER TO IT PUSH TP,B MOVE C,(P) ; GET # OF WORDS ASH C,-10. ; TO PAGES PUSH P,C ; SAVE C MOVNS C HRLZS C ADDI C,FPAG/2000 MOVE B,BUFP ; WINDOW ACTS AS A BUFFER HRRZ D,(TP) ; GET PTR TO START OF UVECTOR JUMPGE C,DUNBLT ; IF < 1 BLOCK LOPBLT: MOVEI A,(C) ; GET A BLOCK PUSHJ P,%SHWND MOVS A,BUFL ; SET UP TO BLT INTO UVECTOR HRRI A,(D) BLT A,1777(D) ; IN COMES ONE BLOCK ADDI D,2000 ; INCREMENT D AOBJN C,LOPBLT ; LOOP DUNBLT: MOVEI A,(C) ; SHARE LAST PAGE PUSHJ P,%SHWND MOVS A,BUFL ; SET UP BLT HRRI A,(D) MOVE C,-1(P) ; GET TOTAL # OF WORDS MOVE 0,(P) ASH 0,10. SUB C,0 ; CALCULATE # LEFT TO GO ADDI D,-1(C) ; END OF UVECTOR BLT A,(D) SUB P,C%22 ; CLEAN OFF STACK PUSHJ P,KILBUF POP TP,B POP TP,A JRST DONDUM ; DONE SETBUF: MOVEI A,1 PUSHJ P,GETBUF MOVEM B,BUFL ASH B,-10. MOVEM B,BUFP POPJ P, ; LITTLE ROUTINES USED ALL OVER THE PLACE MSGTYP: HRLI B,440700 ;MAKE BYTE POINTER MSGTY1: ILDB A,B ;GET NEXT CHARACTER JUMPE A,CPOPJ ;NULL ENDS STRING CAIE A,177 ; DONT PRINT RUBOUTS PUSHJ P,IMTYO JRST MSGTY1 ;AND GET NEXT CHARACTER CPOPJ: POPJ P, ; ROUTINE TO PURIFY A STRUCTURE AND FREEZE ATOMS POINTED TO BY IT. ; TAKES ONE ARGUMENT, THE ITEM TO PURIFY MFUNCTION PURIF,SUBR,[PURIFY] ENTRY JUMPGE AB,TFA ; CHECK # OF ARGS IFE ITS,[ PUSH P,MULTSG SKIPE MULTSG ; MUST RUN I 0 SEXTION MODE PUSHJ P,NOMULT ] MOVE C,AB PUSH P,C%0 ; SLOT TO SEE IF WINNER PURMO1: HRRZ 0,1(C) CAML 0,PURTOP JRST PURMON ; CHECK FOR PURENESS GETYP A,(C) ; SEE IF ITS MONAD PUSHJ P,SAT ANDI A,SATMSK CAIE A,S1WORD CAIN A,SLOCR JRST PURMON CAIN A,SATOM JRST PURMON SKIPE 1(C) ; SKIP IF EMPTY SETOM (P) PURMON: ADD C,C%22 ; INC AND GO JUMPL C,PURMO1 POP P,A ; GET MARKING JUMPN A,PURCON NPF: MOVE A,(AB) ; FINISH IF MONAD MOVE B,1(AB) IFE ITS,[ POP P,MULTSG SKIPE MULTSG PUSHJ P,MULTI ] JRST FINIS PURCON: SETZM SWAPGC PUSHJ P,LODGC ; LOAD THE GARBAGE COLLECTOR SETOM INTHLD SETOM NPWRIT JRST IPURIF EPURIF: PUSHJ P,KILGC SETZM INTHLD SETZM NPWRIT IFE ITS,[ SKIPN MULTSG JRST NPF POP P,B HRRI B,NPF MOVEI A,0 XJRST A ] IFN ITS,[ JRST NPF ] ; ROUTINE TO DO A SPECIAL GARBAGE COLLECT, CALLED FOR FREE STORAGE GARBAGE ; COLLECTS ; AND CAN RUN A MARK/SWEEP GARBAGE COLLECT SAGC: IFE ITS,[ JRST @[.+1] ; RETURN WITH US NOW TO THE THRILLING ; DAYS OF SEGMENT 0 ] SOSL NUMSWP ; GET NUMBER OF SWEEP GARBAGE COLLECTS JRST MSGC ; TRY MARK/SWEEP MOVE RNUMSP ; MOVE IN RNUMSWP MOVEM NUMSWP ; SMASH IT IN JRST GOGC MSGC: SKIPN PGROW ; CHECK FOR STACK OVERFLOW SKIPE TPGROW JRST AGC ; IF SO CAUSE REAL GARBAGE COLLECT PUSH P,C PUSH P,D PUSH P,E SETOM SWAPGC ; LOAD MARK SWEEP VERSION PUSHJ P,AGC1 ; CAUSE GARBAGE COLLECT HRRZ 0,MAXLEN ; SEE IF REQUEST SATISFIED CAMGE 0,GETNUM JRST LOSE1 MOVE C,FREMIN ; GET FREMIN SUB C,TOTCNT ; CALCULATE NEEDED SUB C,FRETOP ADD C,GCSTOP JUMPL C,DONE1 JSP E,CKPUR ; GO CHECK FOR SOME STUFF MOVE D,PURBOT IFE ITS, ANDCMI D,1777 ; MAKE LIKE AN ITS PAGE SUB D,CURPLN ; CALCULATE PURENESS SUB D,P.TOP CAIG D,(C) ; SEE IF PURENESS EXISTS JRST LOSE1 PUSH P,A ADD C,GCSTOP MOVEI A,1777(C) ASH A,-10. PUSHJ P,P.CORE FATAL P.CORE FAILED HRRZ 0,GCSTOP SETZM @0 HRLS 0 ADDI 0,1 HRRZ A,FRETOP BLT 0,-1(A) POP P,A DONE1: POP P,E POP P,D POP P,C IFN ITS, POPJ P, IFE ITS,[ SKIPN MULTSG POPJ P, SETZM 20 POP P,21 ; BACK TO CALLING SEGMENT XJRST 20 ] LOSE1: POP P,E POP P,D POP P,C GOGC: AGC: IFE ITS,[ SKIPE MULTSG SKIPE GCDEBU JRST @[SEC1] XJRST .+1 0 FSEG,,SEC1 SEC1: ] MOVE 0,RNUMSP MOVEM 0,NUMSWP SETZM SWAPGC AGC1: SKIPE NPWRIT JRST IAGC EXCH P,GCPDL PUSHJ P,SVAC ; SAVE ACS PUSHJ P,SQKIL PUSHJ P,CTIME MOVEM B,GCTIM PUSHJ P,LODGC ; LOAD GC PUSHJ P,RSAC ; RESTORE ACS EXCH P,GCPDL SKIPE SWAPGC JRST IAMSGC SKIPN MULTSG JRST IAGC JRST ISECGC AAGC: SETZM SWAPGC EXCH P,GCPDL PUSHJ P,SVAC ; SAVE ACS PUSHJ P,LODGC ; LOAD GC PUSHJ P,RSAC ; RESTORE ACS EXCH P,GCPDL JRST IAAGC FNMSGC: FINAGC: SKIPE NPWRIT JRST FINAGG PUSHJ P,SVAC ; SAVE ACS PUSHJ P,KILGC PUSHJ P,RSAC FINAGG: IFN ITS, POPJ P, IFE ITS,[ SKIPN MULTSG POPJ P, SETZM 20 POP P,21 ; BACK TO CALLING SEGMENT XJRST 20 ] ; ROUTINE TO SAVE THE ACS SVAC: EXCH 0,(P) PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E JRST @0 ; ROUTINE TO RESTORE THE ACS RSAC: POP P,0 POP P,E POP P,D POP P,C POP P,B POP P,A EXCH 0,(P) POPJ P, ; INTERNAL FUNCTION TO GET STRAGE ALLOCATION TYPE ; GETS THE TYPE CODE IN A AND RETURNS SAT IN A. SAT: LSH A,1 ; TIMES 2 TO REF VECTOR HRLS A ; TO BOTH HALVES TO HACK AOBJN ; POINTER ADD A,TYPVEC+1 ; ACCESS THE VECTOR HRR A,(A) ; GET PROBABLE SAT JUMPL A,.+2 ; DID WE REALLY HAVE A VALID ; TYPE MOVEI A,0 ; NO RETURN 0 ANDI A,SATMSK POPJ P, ; AND RETURN ; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A ; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B ; RETURN -1 IN REG B IF NONE FOUND PGFIND: JUMPLE A,FPLOSS CAILE A,256. JRST FPLOSS PUSHJ P,PGFND1 ; SEE IF ALREADY ENOUGH SKIPN NOSHUF ; CAN'T MOVE PURNESS SKIPL B ; SKIP IF LOST POPJ P, SUBM M,(P) PUSH P,E PUSH P,C PUSH P,D PGFLO4: MOVE C,PURBOT ; CHECK IF ROOM AT ALL ; (NOTE POTENTIAL FOR INFINITE LOOP) SUB C,P.TOP ; TOTAL SPACE MOVEI D,(C) ; COPY FOR CONVERSION TO PAGES ASH D,-10. CAIGE D,(A) ; SKIP IF COULD WIN JRST PGFLO1 MOVNS A ; MOVE PURE AREA DOWN "A" PAGES PUSHJ P,MOVPUR MOVE B,PURTOP ; GET FIRST PAGE ALLOCATED ASH B,-10. ; TO PAGE # PGFLOS: POP P,D POP P,C POP P,E PUSHJ P,RBLDM ; GET A NEW VALUE FOR M JRST MPOPJ ; HERE TO SHUFFLE PURE SPACE TO TRY TO FIND PAGES PGFLO1: SKIPE GCFLG ; SKIP IF NOT IN GC JRST PGFLO5 ; WE LOST MOVE C,PURTOP SUB C,P.TOP HRRZ D,FSAV(TB) ; ARE WE IN A PURE RSUBR? CAIL D,HIBOT ; ARE WE AN RSUBR AT ALL? JRST PGFLO2 GETYP E,(R) ; SEE IF PCODE CAIE E,TPCODE JRST PGFLO2 HLRZ D,1(R) ; GET OFFSET TO PURVEC ADD D,PURVEC+1 HRROS 2(D) ; MUNG AGE HLRE D,1(D) ; GET LENGTH ADD C,D PGFLO2: ASH C,-10. CAILE A,(C) JRST PGFLO3 PUSH P,A IFE ITS, ASH A,1 ; TENEX PAGES ARE HALF SIZE PUSHJ P,GETPAG ; SHUFFLE THEM AROUND FATAL PURE SPACE LOSING POP P,A JRST PGFLO4 ; HERE TO CAUSE AGC IF PAGES ARE NOT AVAILABLE EVEN AFTER MAPPING OUT THE WORLD PGFLO3: PUSH P,A ; ASK GC FOR SPACE ASH A,10. MOVEM A,GCDOWN ; REQUEST THOSE PAGES MOVE C,[8.,,9.] PUSHJ P,AGC ; GO GARBAGE COLLECT POP P,A JRST PGFLO4 ; GO BACK TO POTENTIAL LOOP PGFLO5: SETOM B ; -1 TO B JRST PGFLOS ; INDICATE LOSSAGE PGFND1: PUSH P,E PUSH P,D PUSH P,C PUSH P,C%M1 ; POSSIBLE CONTENTS FOR REG B PUSH P,A ; SAVE LENGTH OF BLOCK DESIRED FOR LATER USE SETZB B,C ; INITIAL SECTION AND PAGE NUMBERS MOVEI 0,0 ; COUNT OF PAGES ALREADY FOUND PUSHJ P,PINIT PLOOP: TDNE E,D ; FREE PAGE ? JRST NOTFRE ; NO JUMPN 0,NFIRST ; FIRST FREE PAGE OF A BLOCK ? MOVEI A,(B) ; YES SAVE ADDRESS OF PAGE IN REG A IMULI A,16. ASH C,-1 ; BACK TO PAGES ADDI A,(C) ASH C,1 ; FIX IT TO WHAT IT WAS NFIRST: ADDI 0,1 CAML 0,(P) ; TEST IF ENOUGH PAGES HAVE BEEN FOUND JRST PWIN ; YES, FINISHED SKIPA NOTFRE: MOVEI 0,0 ; RESET COUNT PUSHJ P,PNEXT ; NEXT PAGE JRST PLOSE ; NONE--LOSE RETURNING -1 IN REG B JRST PLOOP PWIN: MOVEI B,(A) ; GET WINNING ADDRESS MOVEM B,(P)-1 ; RETURN ADDRESS OF WINNING PAGE MOVE A,(P) ; RELOAD LENGTH OF BLOCK OF PAGES MOVE 0,[TDO E,D] ; INST TO SET "BUSY" BITS JRST ITAKE ; CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A ; THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B PGGIVE: MOVE 0,[TDZ E,D] ; INST TO SET "FREE" BITS SKIPA PGTAKE: MOVE 0,[TDO E,D] ; INST TO SET "BUSY" BITS JUMPLE A,FPLOSS CAIL B,0 CAILE B,255. JRST FPLOSS PUSH P,E PUSH P,D PUSH P,C PUSH P,B PUSH P,A ITAKE: IDIVI B,16. PUSHJ P,PINIT SUBI A,1 RTL: XCT 0 ; SET APPROPRIATE BIT PUSHJ P,PNEXT ; NEXT PAGE'S BIT JUMPG A,FPLOSS ; TOO MANY ? SOJGE A,RTL MOVEM E,PMAPB(B) ; REPLACE BIT MASK PLOSE: POP P,A POP P,B POP P,C POP P,D POP P,E POPJ P, PINIT: MOVE E,PMAPB(B) ; GET BITS FOR THIS SECTION HRLZI D,400000 ; BIT MASK IMULI C,2 MOVNS C LSH D,(C) ; SHIFT TO APPROPRIATE BIT POSITION MOVNS C POPJ P, PNEXT: AOS (P) ; FOR SKIP RETURN ON EXPECTED SUCCESS LSH D,-2 ; CONSIDER NEXT PAGE CAIL C,30. ; FINISHED WITH THIS SECTION ? JRST PNEXT1 AOS C AOJA C,CPOPJ ; NO, INCREMENT AND CONTINUE PNEXT1: MOVEM E,PMAPB(B) ; REPLACE BIT MASK SETZ C, CAIGE B,15. ; LAST SECTION ? AOJA B,PINIT ; NO, INCREMENT AND CONTINUE SOS (P) ; YES, UNDO SKIP RETURN POPJ P, FPLOSS: FATAL PAGE LOSSAGE PGINT: MOVEI B,HIBOT ; INITIALIZE MUDDLE'S PAGE MAP TABLE IDIVI B,2000 ; FIRST PAGE OF PURE CODE MOVE C,HITOP IDIVI C,2000 MOVEI A,(C)+1 SUBI A,(B) ; NUMBER OF SUCH PAGES PUSHJ P,PGTAKE ; MARK THESE PAGES AS TAKEN POPJ P, ERRKIL: PUSH P,A PUSHJ P,KILGC ; KILL THE GARBAGE COLLECTOR POP P,A JRST CALER ; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU CKPUR: HRRZ A,FSAV(TB) ; GET NAME OF CURRENT GOODIE SETZM CURPLN ; CLEAR FOR NONE CAIL A,HIBOT ; IF LESS THAN TOP OF PURE ASSUME RSUBR JRST (E) GETYP 0,(A) ; SEE IF PURE CAIE 0,TPCODE ; SKIP IF IT IS JRST NPRSUB NRSB2: HLRZ B,1(A) ; GET SLOT INDICATION ADD B,PURVEC+1 ; POINT TO SLOT HRROS 2(B) ; MUNG AGE HLRE A,1(B) ; - LENGTH TO A TRZ A,777 MOVNM A,CURPLN ; AND STORE JRST (E) NPRSUB: SKIPGE B,1(R) ; SEE IF PURE RSUBR JRST (E) MOVE A,R JRST NRSB2 ; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE ; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY ; THEIR MUDDLE. GCSET: MOVE A,RFRETP ; COMPUTE FREE SPACE AVAILABLE SUB A,PARTOP MOVEM A,NOWFRE CAMLE A,MAXFRE MOVEM A,MAXFRE ; MODIFY MAXIMUM HLRE A,TP ; FIND THE DOPE WORD OF THE TP STACK MOVNS A ADDI A,1(TP) ; CLOSE TO DOPE WORD CAME A,TPGROW ADDI A,PDLBUF ; NOW AT REAL DOPE WORD HLRZ B,(A) ; GET LENGTH OF TP-STACK MOVEM B,NOWTP CAMLE B,CTPMX ; SEE IF THIS IS THE BIGGEST TP MOVEM B,CTPMX HLRE B,P ; FIND DOPE WORD OF P-STACK MOVNS B ADDI B,1(P) ; CLOSE TO IT CAME B,PGROW ; SEE IF THE STACK IS BLOWN ADDI B,PDLBUF ; POINTING TO IT HLRZ A,(B) ; GET IN LENGTH MOVEM A,NOWP CAMLE A,CPMX ; SEE IF WE HAVE THE BIGGEST P STACK MOVEM A,CPMX POPJ P, ; EXIT RBLDM: JUMPGE R,CPOPJ SKIPGE M,1(R) ; SKIP IF FUNNY JRST RBLDM1 HLRS M ADD M,PURVEC+1 HLLM TB,2(M) SKIPL M,1(M) JRST RBLDM1 PUSH P,0 HRRZ 0,1(R) ADD M,0 POP P,0 RBLDM1: SKIPN SAVM ; SKIP IF FUNNY (M) POPJ P, ; EXIT MOVEM M,SAVM MOVEI M,0 POPJ P, CPOPJ1: C1POPJ: AOS (P) POPJ P, ; THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE FRMUNG: MOVEM D,PSAV(A) MOVE SP,SPSTOR+1 MOVEM SP,SPSAV(A) MOVEM TP,TPSAV(A) ; SAVE FOR MARKING POPJ P, ; SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE REHASH: MOVE D,ASOVEC+1 ; GET POINTER TO VECTOR MOVEI E,(D) PUSH P,E ; PUSH A POINTER HLRE A,D ; GET -LENGTH MOVMS A ; AND PLUSIFY PUSH P,A ; PUSH IT ALSO REH3: HRRZ C,(D) ; POINT TO FIRST BUCKKET HLRZS (D) ; MAKE SURE NEW POINTER IS IN RH JUMPLE C,REH1 ; BUCKET EMPTY, QUIT REH2: MOVEI E,(C) ; MAKE A COPY OF THE POINTER MOVE A,ITEM(C) ; START HASHING TLZ A,TYPMSK#777777 ; KILL MONITORS XOR A,ITEM+1(C) MOVE 0,INDIC(C) TLZ 0,TYPMSK#777777 XOR A,0 XOR A,INDIC+1(C) TLZ A,400000 ; MAKE SURE FINAL HASH IS + IDIV A,(P) ; DIVIDE BY TOTAL LENGTH ADD B,-1(P) ; POINT TO WINNING BUCKET MOVE C,[002200,,(B)] ; BYTE POINTER TO RH CAILE B,(D) ; IF PAST CURRENT POINT MOVE C,[222200,,(B)] ; USE LH LDB A,C ; GET OLD VALUE DPB E,C ; STORE NEW VALUE HRRZ B,ASOLNT-1(E) ; GET NEXT POINTER HRRZM A,ASOLNT-1(E) ; AND CLOBBER IN NEW NEXT SKIPE A ; SKKIP IF NOTHING PREVIOUSLY IN BUCKET HRLM E,ASOLNT-1(A) ; OTHERWISE CLOBBER SKIPE C,B ; SKIP IF END OF CHAIN JRST REH2 REH1: AOBJN D,REH3 SUB P,C%22 ; FLUSH THE JUNK POPJ P, ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT NWORDT: PUSHJ P,SAT ;GET STORAGE ALLOC TYPE NWORDS: CAIG A,NUMSAT ; TEMPLATE? SKIPL MKTBS(A) ;-ENTRY IN TABLE MEANS 2 NEEDED SKIPA A,C%1 ;NEED ONLY 1 MOVEI A,2 ;NEED 2 POPJ P, .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK .GLOBAL LOCMK,BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,OFFSMK ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,TBMK] [STPSTK,TPMK],[SARGS,],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK] [SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK] [SLOCID,],[SCHSTR,],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK] [SLOCA,],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ASMRK] [SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] IMPURE DSTORE: 0 ; USED FOR MAPFS AND SEGMENTS BUFL: 0 ; BUFFER PAGE (WORDS) BUFP: 0 ; BUFFER PAGE (PAGES) NPWRIT: 0 ; INDICATION OF PURIFY RNUMSP: 0 ; NUMBER OF MARK/SWEEP GARBAGE ; COLLECTS TO REAL GARBAGE COLLECT NUMSWP: 0 ; NUMBER MARK SWEEP GARBAGE COLLECTS TO GO SWAPGC: 0 ; FLAG INDICATING WHETHER TO LOAD SWAP ; GC OR NOT TOTCNT: 0 ; TOTAL COUNT PURE PAT: PATCH: BLOCK 400 PATEND: END