mirror of
https://github.com/PDP-10/its.git
synced 2026-01-18 17:16:59 +00:00
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
|
||
.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
|
||
|