X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Futilit.mid.105;fp=%3Cmdl.int%3E%2Futilit.mid.105;h=8b8b6ff4988133dc5336c20bf86620f11bd6423e;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c diff --git a//utilit.mid.105 b//utilit.mid.105 new file mode 100644 index 0000000..8b8b6ff --- /dev/null +++ b//utilit.mid.105 @@ -0,0 +1,830 @@ +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) + PUSHJ P,RBLDM + 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,1777 + 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 + \ No newline at end of file