--- /dev/null
+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\r
+ 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,
+
+\f
+; 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
+]
+
+
+\f
+; 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,
+
+
+\f
+
+; 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,
+
+
+
+\f
+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,
+
+
+\f
+; 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,
+\f
+;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,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK],[SABASE,ABMK]
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]
+[SLOCR,LOCRMK],[SRDTB,GCRDMK],[SLOCB,<SETZ BYTMK>],[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
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff