mirror of
https://github.com/PDP-10/its.git
synced 2026-01-22 18:42:15 +00:00
26c6e4faa2
Most of these are the same as before. For UUOH, I've taken the fixed ITS conditionals from uuoh.mid.181 (16th March 1981). For MAPPUR, I've put the Tenex conditional around the whole of the segment-switching code since none of it is needed on ITS. Note in particular that the BOT patch is no longer needed -- this version of Muddle works happily with the pure region at 700000.
282 lines
6.5 KiB
Plaintext
282 lines
6.5 KiB
Plaintext
|
||
TITLE MODIFIED AFREE FOR MUDDLE
|
||
|
||
RELOCATABLE
|
||
|
||
.INSRT MUDDLE >
|
||
SYSQ
|
||
|
||
.GLOBAL CAFREE,CAFRET,PARNEW,AGC,PARBOT,CODTOP,CAFRE1
|
||
.GLOBAL STOGC,STOSTR,CAFRE,ISTOST,STOLST,SAT,ICONS,BYTDOP
|
||
.GLOBAL FLIST,STORIC,GPURFL,GCDANG,PVSTOR,SPSTOR
|
||
IFE ITS,.GLOBAL %CLNCO
|
||
|
||
MFUNCTION FREEZE,SUBR
|
||
|
||
ENTRY 1
|
||
|
||
GETYP A,(AB) ; get type of it
|
||
PUSH TP,(AB) ; save a copy
|
||
PUSH TP,1(AB)
|
||
PUSH P,[0] ; flag for tupel freeze
|
||
PUSHJ P,SAT ; to SAT
|
||
MOVEI B,0 ; final type
|
||
CAIN A,SNWORD ; check valid types
|
||
MOVSI B,TUVEC ; use UVECTOR
|
||
CAIN A,S2NWOR
|
||
MOVSI B,TVEC
|
||
CAIN A,SARGS
|
||
MOVSI B,TVEC
|
||
CAIN A,SCHSTR
|
||
MOVSI B,TCHSTR
|
||
CAIN A,SBYTE
|
||
MOVEI B,TBYTE
|
||
JUMPE B,WTYP1
|
||
PUSH P,B ; save final type
|
||
CAMN B,$TBYTE
|
||
JRST .+3
|
||
CAME B,$TCHSTR ; special chars hack
|
||
JRST OK.FR
|
||
HRR B,(AB) ; fixup count
|
||
MOVEM B,(P)
|
||
|
||
MOVEI C,(TB) ; point to it
|
||
PUSHJ P,BYTDOP ; A==> points to dope word
|
||
HRRO B,1(TB)
|
||
SUBI A,1(B) ; A==> length of block
|
||
TLC B,-1(A)
|
||
MOVEM B,1(TB) ; and save
|
||
MOVSI 0,TUVEC
|
||
MOVEM 0,(TB)
|
||
|
||
OK.FR: HLRE A,1(TB) ; get length
|
||
MOVNS A
|
||
PUSH P,A
|
||
ADDI A,2
|
||
PUSHJ P,CAFREE ; get storage
|
||
HRLZ B,1(TB) ; set up to BLT
|
||
HRRI B,(A)
|
||
POP P,C
|
||
ADDI C,(A) ; compute end
|
||
BLT B,(C)
|
||
HLLOS 1(C) ; INDICATION IN RELOCATION FIELD THAT ITS NOT GARBAGE
|
||
MOVEI B,(A)
|
||
HLL B,1(AB)
|
||
POP P,A
|
||
JRST FINIS
|
||
|
||
|
||
CAFRE: PUSH P,A
|
||
HRRZ E,STOLST+1
|
||
SETZB C,D
|
||
PUSHJ P,ICONS ; get list element
|
||
PUSH TP,$TLIST ; and save
|
||
PUSH TP,B
|
||
MOVE A,(P) ; restore length
|
||
ADDI A,2 ; 2 more for dope words
|
||
PUSHJ P,CAFREE ; get the core and dope words
|
||
POP P,B ; restore count
|
||
MOVNS B ; build AOBJN pointer
|
||
MOVSI B,(B)
|
||
HRRI B,(A)
|
||
MOVE C,(TP)
|
||
MOVEM B,1(C) ; save on list
|
||
MOVSI 0,TSTORA ; and type
|
||
HLLM 0,(C)
|
||
HRRZM C,STOLST+1 ; and save as new list
|
||
SUB TP,[2,,2]
|
||
POPJ P,
|
||
|
||
CAFRE1: PUSH P,A
|
||
ADDI A,2
|
||
PUSHJ P,CAFREE
|
||
HRROI B,(A) ; pointer to B
|
||
POP P,A ; length back
|
||
TLC B,-1(A)
|
||
POPJ P,
|
||
|
||
CAFREE: IRP AC,,[B,C,D,E]
|
||
PUSH P,AC
|
||
TERMIN
|
||
SKIPG A ; make sure arg is a winner
|
||
FATAL BAD CALL TO CAFREE
|
||
MOVSI A,(A) ; count to left half for search
|
||
MOVEI B,FLIST ; get first pointer
|
||
HRRZ C,(B) ; c points to next block
|
||
CLOOP: CAMG A,(C) ; skip if not big enough
|
||
JRST CONLIS ; found one
|
||
MOVEI D,(B) ; save in case fall out
|
||
MOVEI B,(C) ; point to new previous
|
||
HRRZ C,(C) ; next block
|
||
JUMPN C,CLOOP ; go on through loop
|
||
HLRZ E,A ; count to E
|
||
CAMGE E,STORIC ; skip if a area or more
|
||
MOVE E,STORIC ; else use a whole area
|
||
MOVE C,PARBOT ; found out if any funny space
|
||
SUB C,CODTOP ; amount around to C
|
||
EXCH B,D
|
||
CAMLE C,E ; skip if must GC
|
||
JRST CHAVIT ; already have it
|
||
SUBI E,-1(C) ; get needed from agc
|
||
MOVEM E,PARNEW ; funny arg to AGC
|
||
PUSH P,A
|
||
MOVE C,[7,,6] ; SET UP AGC INDICATORS
|
||
SKIPE GPURFL ; DONT GC IF IN DUMPER
|
||
JRST PURGC
|
||
PUSHJ P,AGC ; collect that garbage
|
||
SETZM PARNEW ; dont do it again
|
||
POP P,A
|
||
|
||
; Make sure pointers still good after GC
|
||
|
||
MOVEI B,FLIST
|
||
HRRZ D,(B)
|
||
|
||
HRRZ E,(D) ; next pointer
|
||
JUMPE E,.+4 ; end of list ok
|
||
MOVEI B,(D)
|
||
MOVEI D,(E)
|
||
JRST .-4 ; look at next
|
||
|
||
CHAVIT: MOVE C,CODTOP
|
||
MOVE E,PARBOT
|
||
IFE ITS,PUSHJ P,%CLNCO ; flush extra pages
|
||
MOVE E,PARBOT ; find amount obtained
|
||
SUBI E,1 ; dont use a real pair
|
||
MOVEI C,(E) ; for reset of CODTOP
|
||
SUB E,CODTOP
|
||
EXCH C,CODTOP ; store it back
|
||
CAIE B,(C) ; did we simply grow the last block?
|
||
JRST CSPLIC ; no, splice it in
|
||
HLRZ C,(B) ; length of old guy
|
||
ADDI C,(E) ; total length
|
||
ADDI B,(E) ; point to new last dope word
|
||
HRLZM C,(B) ; clobber final length in
|
||
HRRM B,(D) ; and splice into free list
|
||
MOVEI C,(B) ; reset acs for reentry into loop
|
||
MOVEI B,(D)
|
||
JRST CLOOP
|
||
|
||
; Here to splice new core onto end of list.
|
||
|
||
CSPLIC: MOVE C,CODTOP ; point to end of new block
|
||
HRLZM E,(C) ; store length of new block in dope words
|
||
HRRM C,(D) ; D is old previous, link it up
|
||
MOVEI B,(D) ; and reset B for reentry into loop
|
||
JRST CLOOP
|
||
|
||
; here if an appropriate block is on the list
|
||
|
||
CONLIS: HLRZS A ; count back to a rh
|
||
HLRZ D,(C) ; length of proposed block to D
|
||
CAIN A,(D) ; skip if they are different
|
||
JRST CEASY ; just splice it out
|
||
MOVEI B,(C) ; point to block to be chopped up
|
||
SUBI B,-1(D) ; point to beginning of same
|
||
SUBI D,(A) ; amount of block to be left to D
|
||
HRLM D,(C) ; and fix up dope words
|
||
ADDI B,-1(A) ; point to end of same
|
||
HRLZM A,(B)
|
||
HRRM B,(B) ; for GC benefit
|
||
|
||
CFREET: CAIE A,1 ; if more than 1
|
||
SETZM -1(B) ; make tasteful dope worda
|
||
SUBI B,-1(A)
|
||
MOVEI A,(B)
|
||
ACRST: IRP AC,,[E,D,C,B]
|
||
POP P,AC
|
||
TERMIN
|
||
POPJ P,
|
||
|
||
PURGC: SUB P,[1,,1] ; CLEAN OFF STACK
|
||
SETOM GCDANG ; INDICATE GC SHOULD HAVE OCCURED
|
||
JRST ACRST
|
||
|
||
CEASY: MOVEI D,(C) ; point to block to return
|
||
HRRZ C,(C) ; point to next of same
|
||
HRRM C,(B) ; smash its previous
|
||
MOVEI B,(D) ; point to block with B
|
||
HRRM B,(B) ; for GC benefit
|
||
JRST CFREET
|
||
|
||
CAFRET: HRROI B,(B) ; prepare to search list
|
||
TLC B,-1(A) ; by making an AOBJN pointer
|
||
HRRZ C,STOLST+1 ; start of list
|
||
MOVEI D,STOLST+1
|
||
|
||
CAFRTL: JUMPE C,CPOPJ ; not founc
|
||
CAME B,1(C) ; this it?
|
||
JRST CAFRT1
|
||
HRRZ C,(C) ; yes splice it out
|
||
HRRM C,(D) ; smash it
|
||
CPOPJ: POPJ P, ; dont do anything now
|
||
|
||
CAFRT1: MOVEI D,(C)
|
||
HRRZ C,(C)
|
||
JRST CAFRTL
|
||
|
||
; Here from GC to collect all unused blocks into free list
|
||
|
||
STOGC: SETZB C,E ; zero current length and pointer
|
||
MOVE A,CODTOP ; get high end of free space
|
||
|
||
STOGCL: CAIG A,STOSTR ; end?
|
||
JRST STOGCE ; yes, cleanup and leave
|
||
|
||
HLRZ 0,(A) ; get length
|
||
ANDI 0,377777
|
||
SKIPGE (A) ; skip if a not used block
|
||
JRST STOGC1 ; jump if marked
|
||
|
||
; HERE TO SEE WHETHER AN UNMARKED ITEM IS AN ATOM. IF IT IS IT IS NOT GARBAGE
|
||
; AND IT IS PRESERVED WITH ITS VALUE CELLS FLUSHED
|
||
|
||
HLRZ 0,-1(A) ; GET TYPE OF FIRST D.W.
|
||
ANDI 0,TYPMSK ; FLUSH MONITORS
|
||
CAIE 0,SATOM
|
||
JRST STOGC5 ; NOT AN ATOM COLLECT THE GARBAGE
|
||
PUSH P,A ; SAVE PTR TO D.W.
|
||
HLRZ 0,(A)
|
||
SUB A,0 ; POINT TO JUST BEFORE ATOM
|
||
SETZM 1(A) ; ZERO VALUE CELLS
|
||
SETZM 2(A)
|
||
POP P,A ; RESTORE A
|
||
JRST STOGC1
|
||
|
||
STOGC5: HLRZ 0,(A)
|
||
JUMPE C,STOGC3 ; jump if no block under construction
|
||
ADD C,0 ; else add this length to current
|
||
JRST STOGC4
|
||
|
||
STOGC3: MOVEI B,(A) ; save pointer
|
||
MOVE C,0 ; init length
|
||
|
||
STOGC4: SUB A,0 ; point to next block
|
||
JRST STOGCL
|
||
|
||
STOGC1: HLLOS (A) ; -1 IS INDICATOR OF FREE SLOT
|
||
ANDCAM D,(A) ; kill mark bit
|
||
JUMPE C,STOGC4 ; if no block under cons, dont fix
|
||
HRLM C,(B) ; store total block length
|
||
HRRM E,(B) ; next pointer hooked in
|
||
MOVEI E,(B) ; new next pointer
|
||
MOVEI C,0
|
||
JRST STOGC4
|
||
|
||
STOGCE: JUMPE C,STGCE1 ; jump if no current block
|
||
HRLM C,(B) ; smash in count
|
||
HRRM E,(B) ; smash in next pointer
|
||
MOVEI E,(B) ; and setup E
|
||
|
||
STGCE1: HRRZM E,FLIST+1 ; final link up
|
||
POPJ P,
|
||
|
||
IMPURE
|
||
|
||
FLIST: .+1
|
||
ISTOST
|
||
|
||
PURE
|
||
|
||
END
|
||
|