perm filename SAISPC.FAI[S,AIL] blob
sn#191971 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(SPC,,,,,,DUMMYFORGDSCISS)
DEFINE SPCINS <$FUNLK,$FXBLD,$FXGET,$FXG,$FXDEL,$FXD>
COMPXX(SPC,<$GETB,$GET1B,$DELB,$DEL1B,$FSADD,$FSINS,$FSINI,SPCINS>
,<GOGTAB,X22,X33,CORGET,CORREL>
,<SMALL SPACE SERVICE ROUTINES>,,HIIFPOSIB)
BEGIN SPCSER -- SMALL FREE BLOCK SERVICE
%GPROC ←← 1 ;GETTING PROC
%DPROC ←← 2 ;DELETING PROC
%FFRXX ←← 3 ;INDEX OF FIRST FREE LOCATION
HERE($GETB)
MOVE C,-1(P) ;GET SIZE
MOVE USER,GOGTAB ;
SKIPE A,$FSLIS(USER)
PUSHJ P,$GET1B ;CDR DOWN LIST
TDZA A,A ;NO JOY
MOVE A,B ;THE RESULT
RET22: SUB P,X22
JRST @2(P) ;RETURN
HERE($DELB)
MOVE B,-1(P) ;THE BLOCK
MOVE USER,GOGTAB
SKIPE A,$FSLIS(USER)
PUSHJ P,$DEL1B
MOVEI A,0
JRST RET22
GET1B1: HRRZ A,(A) ;PART OF THE $GET1B LOOP
HERE($GET1B)
JUMPE A,CPOPJ ;CHECK NULLITUDE
PUSHJ P,@%GPROC(A) ;CALL THE ROUTINE
JRST GET1B1 ;LOOP ON TO NEXT, THIS ONE LOST
CPOPJ1: AOS (P) ;SKIP RETURN IF WIN
CPOPJ: POPJ P, ;RETURN
DEL1B1: HRRZ A,(A) ;SAME KLUGE
HERE($DEL1B)
JUMPE A,CPOPJ ;
PUSHJ P,@%DPROC(A) ;ALLOCATE ROUTINE
JRST DEL1B1 ;LOST, TRY NEXT
JRST CPOPJ1 ;WIN
HERE($FSADD) ;LINKS IN ONE BLOCK
MOVE USER,GOGTAB
MOVEI LPSA,$FSLIS(USER)
PUSH P,LPSA ;THIS IS THE OWNER
PUSH P,-2(P) ;THE RECORD TO ADD
PUSHJ P,$FSINS ;CALL INSERT ROUTINE
JRST RET22 ;GO RETURN
HERE($FUNLK)
MOVE LPSA,-1(P) ;THE BLOCK WE ARE TO UNLINK
MOVE TEMP,(LPSA) ;THE LEFT,,RIGHT
TRNE TEMP,-1 ;IF HAVE A RIGHT HAND
HLLM TEMP,(TEMP) ;LET HIM HOLD MY LEFT
MOVSS TEMP ;SWAP HALVES
HLRM TEMP,(TEMP) ;LET HIM HOLD MY RIGHT
JRST RET22 ;DONE
HERE($FSINS) ;
HRRZ TEMP,-1(P) ;THE THING TO INSERT
HRRZ LPSA,-2(P) ;ADDRESS OF OWNER CELL
HRLM LPSA,(TEMP) ;REMEMBER AS BACK POINTER
EXCH LPSA,(LPSA) ;LPSA IS NOW FWD PTR
TRNE LPSA,-1 ;WAS THE CHAIN NULL?
HRLM TEMP,(LPSA) ;NO HE GETS A BACK PTR TOO
HRRM LPSA,(TEMP) ;OLD HEAD IS NEW RIGHT BROTHER
RET33: SUB P,X33 ;RETURN
JRST @3(P) ;
NOLOW <
NOUP <
REN <
USE
>;REN
FSI: 0
$FSINI
0
LINK %INLNK,FSI
REN <
USE HIGHS
>;REN
>;NOUP
>;NOLOW
HERE($FSINI)
SKIPN USER,GOGTAB
ERR <$FSINI CALLED W/O GOGTAB INITIALIZED>
SKIPE $FSLIS(USER)
ERR <$FSINI CALLED WITH THINGS ON $FSLIS>,1
MOVEI C,3 ;JUST A LITTLE BLOCK
PUSHJ P,CORGET
ERR <CORGET DIDN'T GIVE ME ANY>,1
HRRZM B,$FSLIS(USER)
HRLZI C,$FSLIS(USER)
MOVEM C,(B)
MOVEI C,CORGET
MOVEM C,%GPROC(B)
MOVEI C,[PUSHJ P,CORREL
AOS(P)
POPJ P,
]
MOVEM C,%DPROC(B)
POPJ P,
%FXIX ←← %FFRXX ;FIRST LEGAL FIELD
DEFINE $FXFLD(ID) <
ID ←← %FXIX
%FXIX ←← %FXIX+1
>
$FXFLD %BLKSIZ ;BLOCK SIZE
$FXFLD %MINSIZ ;MIN ACCEPTABLE SIZE
$FXFLD %BLKCNT ;NUMBER OF BLOCKS PER SPACE
$FXFLD %USECNT ;NUMBER OF BLOCKS ALLOCATED FROM THIS SPACE
$FXFLD %MAXADR ;MAX ADDRESS OF A BLOCK IN THIS SPACE
$FXFLD %FRELIS ;FREE LIST
$FXFLD %SUBLIS ;SUBLIST OF SIMILAR BLOCKS
$FXFLD %FIRBLK ;FIRST DATA WORD
HERE($FXGET)
CAMG C,%BLKSIZ(A) ;WOULD IT FIT
CAMGE C,%MINSIZ(A) ;
POPJ P, ;NO
PUSH P,A ;YEP GO DOWN KINDERN
FGTRY: SKIPE A,%SUBLIS(A) ;IF ANY
PUSHJ P,$GET1B ;
JRST ADDAB ;ADD A BLOCK
FGWIN: POP P,A ;I AM SUCH A WINNER
JRST CPOPJ1 ;& GO WIN
ADDAB: MOVE A,(P) ;SINCE A IS ZERO AT THIS POINT
MOVEI B,%SUBLIS(A) ;OWNER OF NEW LIST
PUSH P,B ;BUILD CALL TO $FXBLD
PUSH P,-1(P) ;PUSH A COPY OF A
PUSHJ P,$FXBLD ;MAKES A NEW SPACE FOR $FXG
MOVE A,(P) ;WHERE WE HAD SAVED IT
JRST FGTRY ;GO TRY AGAIN -- EXPECT TO WIN
HERE($FXG)
CAMG C,%BLKSIZ(A) ;WOULD IT FIT?
CAMGE C,%MINSIZ(A) ;
POPJ P, ;NO WAY
SKIPN B,%FRELIS(A) ;ONE ON FREE LIST
POPJ P, ;NO SUCH LUCK
AOS %USECNT(A) ;ONE LESS FREE NOW
PUSH P,(B) ;KLUGY WAY TO COPY FREE LIST
POP P,%FRELIS(A) ;PUTS BACK THE NEXT ONE
JRST CPOPJ1 ;GO SKIP RETURN -- WE WIN
HERE($FXDEL)
PUSH P,A ;IN THIS CASE, JUST GO DOWN CHILDREN
SKIPE A,%SUBLIS(A) ;
PUSHJ P,$DEL1B ;LIKE SO
SOS -1(P) ;WILL NA SKIP RETURN
POP P,A ;GET OWN NAME BACK
JRST CPOPJ1 ;I AM A WINNER
HERE($FXD)
CAMG B,%MAXADR(A) ;IN RANGE?
CAIG B,(A) ;A IS MY OWN POINTER,REMEMBER
POPJ P, ;NOPE
SOSG %USECNT(A) ;IF THIS WAS THE LAST
JRST BIGKIL ;THEN THE WHOLE BLOCK GOES AWAY
PUSH P,B ;MUST PRESERVE
HRRZS B ;JUST BE SURE RHS ONLY IS ON
EXCH B,%FRELIS(A) ;SAVE AWAY NEW LIST
MOVEM B,@%FRELIS(A) ;& LINK IT TO OLD
POP P,B ;GET BACK
JRST CPOPJ1 ;WHAT WINNAGE!
BIGKIL: PUSH P,LPSA ;SAVE A COUPLE
PUSH P,TEMP ;
PUSH P,B
PUSH P,A ;GO UNLINK THIS BLOCK
PUSHJ P,$FUNLK ;LIKE SO
MOVE B,A ;GO CLOBBER THE WHOLE BLOCK
PUSHJ P,CORREL ;LIKE SO
POP P,B ;A PITY CANNOT JUST ZERO OUT B
POP P,TEMP ;GET ACS BACK
POP P,LPSA ;
JRST CPOPJ1 ;RETURN
HERE($FXSPC)
MOVEI C,%FIRBLK ;HOW BIG IT NEEDS TO BE
PUSHJ P,CORGET ;USE CORGET SPACE FOR THIS (DONT REALLY HAVE TO
ERR <NO CORE TO BE HAD>,1 ; BUT MAY WANT TO DO THIS AT FUNNY TIMES)
MOVE A,B ;WHERE WE WILL RETURN VALUE
HRL B,B ;CLEANSE IT
HRRI B,1(B)
SETZM (B)
BLT B,%FIRBLK-1(A)
MOVEI B,$FXGET ;
MOVEM B,%GPROC(A)
MOVEI B,$FXDEL
MOVEM B,%DPROC(A)
POP P,B
POP P,%BLKCNT(A)
POP P,%MINSIZ(A)
POP P,%BLKSIZ(A)
JRST (B)
HERE($FXBLD)
MOVE A,-1(P) ;MUST ADD A BLOCK
PUSH P,C ;SAVE THIS SIZE REQUEST
PUSH P,TEMP ;SAVE A COUPLE ACS
PUSH P,LPSA ;WHICH WE PROMISSED NOT TO MUNGE
PUSH P,B
SKIPN C,%BLKCNT(A) ;
ERR <IT DOESN'T HELP YOU MUCH TO ALLOCATE ZERO MORE BLOCKS>,1,L1DON
IMUL C,%BLKSIZ(A) ;B ← NOMINAL BLOCK SIZE * COUNT + OVERHEAD
ADDI C,%FIRBLK ;
PUSHJ P,CORGET ;A BLOCK OF THIS GREAT SIZE
ERR <COULDN'T GET ANY MORE SPACE FROM CORGET>,1
MOVEI TEMP,%FIRBLK(A) ;NOW CHAIN ALL SUB-BLOCKS TOGETHER
MOVEI LPSA,0 ;
MOVE C,%BLKCNT(A) ;SO WE WILL COUNT DOWN
MOVEM C,%BLKCNT(B) ;ALSO, THE BLOCK COUNT FOR THIS
L1B: MOVEM LPSA,(TEMP) ;POINT TO NEXT
MOVE LPSA,TEMP ;REMEMBER THE BACK POINTER
ADD TEMP,%BLKSIZ(A) ;NEXT BLOCK
SOJG C,L1B ;COUNT DOWN TO ZERO
L1DON: MOVEM LPSA,%FRELIS(B) ;THIS IS THE FIRST FREE
MOVEM LPSA,%MAXADR(B) ;ALSO THE MAX ADDRESS BLOCK IN THIS SPACE
SETZM %USECNT(B) ;USE COUNT IS ZERO
SETZM %SUBLIS(B) ;THE SUBLIST IS ZERO
MOVE LPSA,%MINSIZ(A) ;COPY THESE, TOO (HRROI POP IS FASTER
MOVEM LPSA,%MINSIZ(B) ;BUT THIS ALLOWS EASIER REARRANGEMENT)
MOVE LPSA,%BLKSIZ(A) ;
MOVEM LPSA,%BLKSIZ(B) ;
MOVEI LPSA,$FXG ;THE HANDLERS FOR THESE
MOVEM LPSA,%GPROC(B) ;REMEMBER THE HANDLER
MOVEI LPSA,$FXD
MOVEM LPSA,%DPROC(B) ;
PUSH P,-6(P) ;GO LINK ONTO THIS ADDRESS
PUSH P,B ;THE BLOCKID
PUSHJ P,$FSINS ;USING THE STANDARD INSERTER
POP P,B
POP P,LPSA ;GET ACS BACK
POP P,TEMP ;
POP P,C ;
SUB P,X33
JRST @3(P) ;RETURN
BEND SPCSER
ENDCOM (SPC)
END