perm filename SAICOR.FAI[S,AIL]2 blob
sn#178617 filedate 1975-09-28 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(COR,<CORREL,CORGET,CORINC,CANINC,CORBIG>
,<.EXPIN,.TRACS,X11,GOGTAB,.ERBWD>
,<CORGET, CORREL, ... -- CORE ALLOCATION ROUTINES>)
SUBTTL Core Service Routines -- General Description
IFN ALWAYS,<BEGIN CORSER>
CMU <
GGAS <
IFE ALWAYS,<EXTERNAL TOP2,GLBPNT,GAS>
>;GGAS
>;CMU
NOLOW < ;INCLUDE IN UPPER SEGMENT.
SUBTTL Special AC Declarations
DEBCOR ←←0 ;SWITCH FOR CORE DEBUGGING ROUTINES.
CMU <
DEBGAS ←← 0 ;FOR GAS CORE STUFF
>;CMU
SIZ ←← 3 ;SIZE OF BLOCK BEING OBTAINED OR RELEASED
THIS ←← 2 ;POINTER TO SAME
NEXT ←← 1 ;POINTER TO SUCCESSOR
PREV ←← 5 ;POINTER TO PREDECESSOR
LAST ←← 6 ;POINTER TO NEXT-HIGHER NEIGHBOR
TRIVIAL ←←=10 ;AMOUNT WE'RE WILLING TO WASTE
CMU <
GGAS <
TM ←← 7 ;MODULE NUMBER
GASAD ←← 4 ;ADDRESS OF GAS
>;GGAS
>;CMU
SUBTTL Utility Routines
UNLINK:
HRRZ NEXT,(THIS) ;PTR TO NEXT BLOCK
HLRZ PREV,(THIS) ;PTR TO PREVIOUS BLOCK
SKIPN PREV ;IF A PREV BLOCK DOES NOT EXIST,
MOVEI PREV,FRELST(USER) ; USE FRELST POINTER
HRRM NEXT,(PREV) ;CHANGE ITS NEXT FIELD
SKIPE NEXT ;IF A NEXT BLOCK EXISTS,
HRLM PREV,(NEXT) ; CHANGE ITS PREV FIELD
POPJ P, ;BLOCK IN "THIS" IS NO LONGER ON FRELST
RELINK:
HRRZM THIS,-1(LAST) ;X-BIT ← 0, RH ← PTR TO HEAD
MOVEM SIZ,1(THIS) ;GREATER 0 SIZE FIELD then FREE BLOCK
PUSH P,PREV ;NEED ANOTHER AC (FOR PREV)
MOVEI NEXT,FRELST(USER) ;ADDRESS OF THE ANCHOR
JRST RELKIN
RELKNX: CAIG THIS,(NEXT)
JRST RELKDN ;THIS IS WHERE IT GOES
RELKIN: MOVEI PREV,(NEXT) ;COPY NEXT INTO PREV
HRRZ NEXT,(NEXT) ; AND GET THE NEXT NEXT
JUMPN NEXT,RELKNX ;IF NOT END-OF-LIST, TRY AGAIN
SKIPA ;END OF LIST, SO DON'T
RELKDN: HRLM THIS,(NEXT) ;PT TO THIS FROM NEXT
HRRM THIS,(PREV) ;PT TO THIS FROM PREV (OR FRELST(USER))
HRRZM NEXT,(THIS) ;PT TO NEXT FROM THIS
CAIE PREV,FRELST(USER) ;THIS IS PROBABLY SUPERFLUOUS....
HRLM PREV,(THIS) ;PT TO PREV FROM THIS
POP P,PREV ;AND RESTORE THE AC
POPJ P, ;RETURN
CMU < GGGON
>;CMU
GLOB <
IFN 0,<
↑GLCOR:
SKIPE GLBPNT
POPJ P, ;ALREADY INITIALIZED.
MOVEM 16,GLUSER+LEABOT+16
MOVEI 16,GLUSER+LEABOT
BLT 16,GLUSER+LEABOT+15
MOVEI 3,3(13) ;GET SIZE REQUIRED.PLUS SOME BECAUSE BLT LOSES.
PUSHJ P,CORE2 ;GET SECOND SEGMENT CORE.
JRST [TERPRI <NO CORE FOR GLOBAL MODEL>
CALL6 (EXIT)]
SUBI 2,1
MOVEM 2,GLBPNT ;AND RECORD IT.
SETZM 1(2) ;FIRST WORD.
HRRI 2,2(2) ;SECOND WORD.
HRLI 2,-1(2) ;FIRST WORD.
ADDI 3,-2(2) ;LENGTH.
BLT 2,(3) ;ZERO IT.....
MOVSI 16,GLUSER+LEABOT
BLT 16,16 ;RESTORE ALL LOADER'S AC'S AGAIN.
POPJ P, ;AND GO AWAY.
>
↑CORE2I:
PUSH P,USER
NOCMU <
MOVE USER,[XWD GLUSER+LEABOT+20,GLUSER+LEABOT+21]
SETZM GLUSER+LEABOT+20
>;NOCMU
CMU <
NOGGAS <
MOVE USER,[XWD GLUSER+LEABOT+20,GLUSER+LEABOT+21]
SETZM GLUSER+LEABOT+20
>;NOGGAS
GGAS <
MOVE USER,[XWD GLUSER+ZAPBEG,GLUSER+ZAPBEG+1]
SETZM GLUSER+ZAPBEG
>;GGAS
>;CMU
BLT USER,GLUSER+ZAPEND
POP P,USER ;NOW DATA AREA IS ZERO.
MOVEI USER,GLUSER ;SET UP FOR CORE2.
PUSHJ P,JUSTSAVE ;AND SAVE AC'S
SETOM CORLOK ;THE LOCK ...
SETOM GLBPNT ;AND THE SWITCH SAYING INITED.
MOVE THIS,TOP2 ;LAST ADDRESS IN SEC. SEG USED.
ADDI THIS,1
MOVEM THIS,LOWC(USER) ;SAVE FOR LATER
CMU <
GGAS < ;LET'S GET SOME CORE TO USE
HRRZ USER,GLUSXX ; ****** KLUGE TO GET AROUND LOADER FUCKUP
MOVEI TEMP,(THIS)
ADDI TEMP,2000
HRLZS TEMP
CALLI TEMP,11 ;CORE UUO
ERR <CORE2I: CAN'T GET CORE FOR GAS>
HRROS JOBHRL ;SO MONITOR WON'T SAVE HISEG
SETZM GAS ;WE HAVE NO GGAS YET
>;GGAS
>;CMU
PUSHJ P,NEWB2 ;AND LINK UP.
JRST BUFRST ;ALL DONE INITIALIZING.
CORLOK: 0
CR2BEG: BLOCK ZAPEND-ZAPBEG+1 ;AREA FOR ALL OTHERS.
↑↑GLUSER←CR2BEG-ZAPBEG ;AND THE MAGIC INDEX.
INTERNAL GLUSER
CMU <
GLUSXX: GLUSER ;KLUGE TO GET AROUND FAIL OR LOADER LOSSAGE AT CMU
>;CMU
>;GLOB
CMU < GGGOFF
>;CMU
BUFRST:
IFN DEBCOR,<
SKIPE PRTCOR ;SHOULD WE DEBUG?
JFCL
>
MOVSI TEMP,BUFACS(USER)
BLT TEMP,LAST
POPJ P,
BUFSAV:
CMU < GGGON
>;CMU
GLOB <
SKIPN GLBPNT ;HAS GLOBAL MODEL BEEN INITIALIZED?
PUSHJ P,CORE2I ;NO --INITIALIZE IT.
>;GLOB
CMU < GGGOFF
>;CMU
SKIPE USER,GOGTAB ;CAN WE GO AHEAD?
JRST JUSTSAVE ; YES
NOEXPO <
MOVEI TEMP,=76*=1024 ;ONE REALLY MUST KNOW WHAT HE
>;NOEXPO
EXPO <
MOVEI TEMP,-1 ;FOR MAX CORE
>;EXPO
MOVEM TEMP,JOBFF ; IS DOING
HLRZ USER,JOBSA ;USER TABLE ADDRESS
MOVEI USER,5(USER) ;ROOM FOR GOGTAB ARRAY DESCRIPTOR
SKIPN JOBDDT ;IF DDT IS IN CORE,
JRST NODDT ; MAKE SURE ITS SYMBOLS ARE PROTECTED
HRRZ TEMP,JOBSYM ;IF JOBSYM IS BELOW JOBFF, THEN
CAIGE TEMP,400000
CAMGE TEMP,USER ; ASSUME ALL SYMBOLS ARE BELOW.
JRST .+2
TERPRI <YOUR SYMBOLS ARE SOON TO BE OBLITERATED>
NODDT: MOVEI TEMP,ENDREN-CLER+=2000(USER) ;MAKE SURE
CAMGE TEMP,JOBREL ; ENOUGH CORE EXISTS
JRST CORTHER ; FOR USER TABLE
NOTENX <
CALL6 (TEMP,CORE) ;GET ENOUGH
CORERR <DRYROT -- NO ROOM FOR USER TABLE>
>;NOTENX
TENX <
HRRZM TEMP,JOBREL
>;TENX
CORTHER:
MOVEM USER,-5(USER) ;BASE WORD
MOVEM USER,GOGTAB ;THIS TIME FOR SURE
SETZM -4(USER) ;LOWER BOUND
MOVE TEMP,[XWD 1,ENDREN] ;SOME CONSTANTS
HRRZM TEMP,-3(USER) ;UPPER BOUND
HLRZM TEMP,-2(USER) ;MULTIPLIER
ADDI TEMP,1
MOVEM TEMP,-1(USER) ;NUM DIMS,,TOT SIZ
SETZM .ERBWD
SETZM (USER) ;CLEAR USER TABLE
HRL TEMP,USER
HRRI TEMP,1(USER)
BLT TEMP,ENDREN-CLER(USER)
MOVEI THIS,ENDREN-CLER(USER) ;SET UP LIMITS OF FREE SPACE
MOVEM THIS,LOWC(USER) ; BOTTOM
PUSHJ P,NEWBLK ;MAKE NEW AREA INTO A FREE BLOCK
JRST JUSTSAVE ;SAVE ACS
GLOB <
NEWB2: CALL6 (LAST,SEGSIZ) ;FIND OUT HOW BIG.
TRO LAST,400000 ;SINCE ANDY DOES NOT GIVE ME THIS.
JRST NEWB1
>;GLOB
CMU <
GGAS <
NEWB2: HRRZ LAST,JOBHRL ;FIND HOW BIG
JRST NEWB1
>;GGAS
>;CMU
NEWBLK:
HRRZ LAST,JOBREL ;END OF BIG BLOCK
NEWB1: SETZM (THIS) ;POINTERS WORD IN BIG BLOCK
ADDI LAST,1 ;CONFORM TO "LAST" STANDARDS
MOVEM LAST,TOP(USER) ;TOP OF FREE SPACE
PUSH P,SIZ ;SAVE SIZE
MOVE SIZ,LAST ;COMPUTE SIZE OF NEW BLOCK
SUB SIZ,THIS ;SIZE OF BIG BLOCK
PUSHJ P,RELINK ;PUT ON FREE STORAGE LIST
POP P,SIZ ;GET SIZ BACK
POPJ P,
JUSTSAVE:
MOVEI TEMP,BUFACS(USER)
BLT TEMP,BUFACS+LAST(USER)
IFN DEBCOR,<
SKIPE PRTCOR ;SHOULD WE DEBUG?
PUSHJ P,CORPRT ; YES
>
POPJ P,
IFN DEBCOR,<
↑PRTCOR: 0
>
SUBTTL CORGET
HERE(CORGET)
IFN DEBCOR,<
SKIPE PRTCOR
TERPRI <CORGET: > ;TELL THE PEOPLE WHO YOU ARE
>
PUSHJ P,BUFSAV ;SAVE AC'S, INITIALIZE WORLD PERHAPS
GLOB <
SKIPN USCOR2(USER) ;ARE WE INSTRUCTED TO USE CORE2?
JRST COR21 ;NOPE -- GO AHEAD.
↑↑CORE2: SKIPN GLBPNT ;HAS IT BEEN INITIALIZED?
PUSHJ P,CORE2I ;NO -- BUT NOW.
AOSE CORLOK ;CAN WE GET THROUGH THE LOCK?
JRST [SOS CORLOK ;APPARENTLY NOT.
PUSHJ P,WAITQQ ;WAIT
JRST .-1]
MOVEI USER,GLUSER ;USE THIS VERSION OF USER.
PUSHJ P,JUSTSAVE ;JUST SAVE THE ACCUMULATORS.
>;GLOB
NOCMU <
COR21: ADDI SIZ,3 ;3 WORDS FOR CONTROL INFO
>;NOCMU
CMU <
GGAS <
SKIPN USCOR2(USER) ;ARE WE INSTRUCTED TO USE CORE2?
JRST COR21 ;NOPE -- GO AHEAD.
↑↑CORE2:
IFN DEBGAS,<
SKIPE PRTCOR
TERPRI <CORE2:> ;FOR GAS
>;DEBGAS
SKIPN GLBPNT ;HAS IT BEEN INITIALIZED?
PUSHJ P,CORE2I ;NO -- BUT NOW.
AOSE CORLOK ;CAN WE GET THROUGH THE LOCK?
JRST [SOS CORLOK ;APPARENTLY NOT.
MOVEI TEMP,0
CALLI TEMP,31 ;SLEEP 0 SECONDS
JRST .-1]
MOVEI USER,GLUSER ;USE THIS VERSION OF USER.
PUSHJ P,JUSTSAVE ;JUST SAVE THE ACCUMULATORS.
>;GGAS
COR21: ADDI SIZ,3 ;3 WORDS FOR CONTROL INFO
IFN DEBGAS,<
CAIN USER,GLUSER
SKIPN PRTGAS
JRST GETPRT
PRINT < MODULE=>
OCTPNT TM
PRINT < SIZE=>
OCTPNT SIZ
GETPRT:
>;IFN DEBGAS
>;CMU
SKIPE ATTOP(USER) ;IF USER REQUESTS IT, GET BLOCK
JRST EXPAND ; AT TOP OF CORE
MOVEI THIS,FRELST(USER) ;THIS WILL POINT TO THE FIRST GOOD BLOCK
GETLUP: HRRZ THIS,(THIS) ;PTR TO NEXT FREE BLOCK
JUMPE THIS,EXPAND ;TRY TO EXPAND CORE, NONE EXIST YET
CAMLE SIZ,1(THIS) ;WILL IT FIT?
JRST GETLUP ; NO, TRY NEXT
GETCOR: AOS (P) ;SUCCESS GUARANTEED
HRRZM THIS,BUFACS+THIS(USER) ;RESULT(ALMOST)
PUSHJ P,UNLINK ;UNLINK THIS BLOCK
MOVE LAST,1(THIS) ;REAL BLOCK SIZE
CAIGE LAST,TRIVIAL(SIZ) ;IS DIFFERENCE NEGLIGIBLE?
JRST [MOVSI TEMP,400000 ;YES, USE WHOLE THING --
ADD LAST,THIS ; MARK X-BIT TO INDICATE IN USE
HLLM TEMP,-1(LAST)
JRST GETOUT] ;AND GO FINISH OUT
MOVEM SIZ,1(THIS) ;NEW SIZE FOR RESULT
HRRZ TEMP,THIS ;SAVE START OF BLOCK (RESULT)
ADD THIS,SIZ ;NEW START FOR REMAINING FREE STUFF
SUB LAST,SIZ ;NEW SIZE FOR REMAINS
MOVE SIZ,LAST
ADD LAST,THIS ;NEW END FOR REMAINS
HRLI TEMP,400000 ;TURN X-BIT ON
MOVEM TEMP,-1(THIS) ;IN USER'S BRAND NEW BLOCK
PUSHJ P,RELINK ;RELINK REMAINS, RESTORE ACS
GETOUT: PUSHJ P,GETRST ;RESTORE ACS
SETZM (THIS) ;PTR RETRIEVED FROM STORAGE
MOVNS 1(THIS) ;SIZE NEG MEANS IN USE
CMU <
IFN GASSW,<TRNN THIS,400000
JRST COR2GT
MOVEM TM,(THIS) ;STORE MODULE #
IFN DEBGAS,<
SKIPN PRTGAS
JRST COR2GT
PRINT < LOC=>
MOVE TEMP,THIS
OCTPNT TEMP
TERPRI
>;IFN DEBGAS
COR2GT:
>;IFN GASSW
>;CMU
ADDI THIS,2 ;USER DOESN'T SEE THIS HEADER
IFN DEBCOR,<
SKIPE PRTCOR
PUSHJ P,CORPRT
>
POPJ P, ;HERE'S YOUR BLOCK!
EXPAND: SKIPE XPAND(USER) ;IS IT ALLOWED TO EXPAND?
JRST GETRST ; NO, ERROR RETURN
PUSH P,SIZ ;SAVE TOTAL SIZE
HRRZ THIS,TOP(USER) ;THIS PNTS TO NEW BLOCK IF NEXT LOWER IS USED
SKIPGE -1(THIS) ;IS TOP BLOCK FREE?
JRST GETMOR ; NO, USE WHAT YOU HAVE
HRRZ THIS,-1(THIS) ;UNLINK THE
PUSHJ P,UNLINK ; TOP BLOCK
GETMOR: MOVE TEMP,THIS
ADDI TEMP,=1024(SIZ) ;GET MORE AND THEN SOME
POP P,SIZ ;GET THIS BACK BEFORE YOU FORGET
CMU < GGGON ;SO TRPCAL WORKS ?
>;CMU
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT) ;TRAP TO USER IF DESIRED
CMU < GGGOFF ;
>;CMU
GLOB <
CAIN USER,GLUSER ;THIS IS HOW WE TELL
JRST [CALL6 (TEMP,CORE2) ;GET SOME CORE
JRST BLEWIT ;HE SPAT UPON OUR HUMBLE REQUEST.
PUSHJ P,NEWB2 ;LINK IT UP
JRST GETM.1]
>;GLOB
CMU <
GGAS <
CAIN USER,GLUSER
JRST [ HRLZ TEMP,TEMP ;
TLO TEMP,400000 ;
CALL6 (TEMP,CORE) ; DO THE CORE UUO
JRST BLEWIT ; NO JOY
MOVNS TEMP
GGGON
TRPCAL(SIZ,TEMP,X11,X11,.EXPINT) ;TRAP TO LOSER
GGGOFF
HRROS JOBHRL ;SO DONT SAVE HISEG
PUSHJ P,NEWB2 ;LINK IT UP
JRST GETM.1 ] ;
>;GGAS
>;CMU
UP <
TENX <
IFNDEF SEGLOC, <SEGLOC←←400000>
CAIL TEMP,SEGLOC ;WELL??
JRST BLEWIT ;GREAT EROR
>;TENX
NOTENX <
CAIL TEMP,400000 ;
JRST BLEWIT ;
>;NOTENX
>;UP
NOTENX <
CALL6 (TEMP,CORE) ;ASK FOR MORE
JRST BLEWIT ;CAN'T GET IT
>;NOTENX
TENX <
HRRZM TEMP,JOBREL ;SEE COMMENT @ NODDT ABOVE
>;TENX
MOVNS TEMP
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT) ;TRAP TO USER NOW THAT HAVE CORE
PUSHJ P,NEWBLK ;MAKE TOP LOOK LIKE FREE BLOCK
GETM.1: CAMLE SIZ,1(THIS) ;NOW SHOULD FIT
CORERR <DRYROT -- EXPAND CODE GLUBBED UP>
JRST GETCOR ;GO GET BLOCK
BLEWIT: MOVNS SIZ
MOVNS TEMP
TRPCAL(SIZ,TEMP,X11,X11,.EXPINT)
GETRST:
CMU < GGGON
>;CMU
GLOB <
PUSHJ P,BUFRST ;RESTORE ACCUMULATORS.
CAIN USER,GLUSER ;WAS IT CORE2?
SOS CORLOK ;YES -- BACK UP COUNT.
MOVE USER,GOGTAB ;RESET IT TO USUAL.
POPJ P, ;
>;GLOB
JRST BUFRST
CMU < GGGOFF
>;CMU
SUBTTL CORINC, CANINC
HERE(CORINC)
IFN DEBCOR,<
SKIPE PRTCOR
TERPRI <CORINC:>
>
PUSHJ P,JUSTSAVE ;SAVE ACS
MOVNI FF,1 ;WANT TO DO IT
JRST INCR
HERE(CANINC)
IFN DEBCOR,<
SKIPE PRTCOR
TERPRI <CANINC: >
>
PUSHJ P,BUFSAV
MOVEI FF,0 ;JUST WANT TO SEE IF IT'S POSSIBLE
INCR: SUBI THIS,2 ;POINT AT REAL BLOCK HEAD
CMU < GGGON
>;GGGOFF
GLOB <
TRNE THIS,400000 ;CHECK TO SEE IF CORE2
CORERR <NO CANINC SECOND SEGMENT SPACE>
>;GLOB
CMU < GGGOFF
>;CMU
HRRZ LAST,THIS ;CHECK AT TOP
SUB LAST,1(THIS) ; ADDR OF END (SIZE IS NEG)
CAMGE LAST,TOP(USER) ;TOP BLOCK?
JRST MIDDLE ; NO
JUMPE FF,YESINC ;SUCCESS
MOVNS 1(THIS) ;MAKE IT LOOK FREE
ADD SIZ,1(THIS) ;TOTAL SIZE
HRRZS -1(LAST) ;MAKE END LOOK FREE
JRST EXPAND ;EXPAND AND RETURN
MIDDLE: SKIPGE TEMP,1(LAST) ;NEXT BLOCK FREE?
JRST NONEATALL ; NO, FAILURE
SUBI TEMP,3 ;AVAILABLE SIZE
CAMLE SIZ,TEMP ;IS THERE ENOUGH?
JRST MAYBE ; NO, FAILURE MAYBE
JUMPE FF,YESINC ;ALL OK, CAN DO, REPORT IT
CRXXB: MOVNS TEMP,1(THIS) ;MAKE IT LOOK FREE
PUSH P,(THIS) ;WILL RESTORE THIS IN CASE SOMEONE USED
PUSH P,THIS ;SAVE SIZE
PUSH P,SIZ ;AND POINTER
ADDM TEMP,(P) ;TOTAL SIZE DESIRED AFTER RETURN
MOVE SIZ,TEMP ;SIZE OF CURRENT "THIS"
HRRZ THIS,LAST ;MERGE "THIS" WITH "LAST"
PUSHJ P,UNLINK ;TAKE IT OFF FRELST
ADD LAST,1(THIS) ;AND INCREASE
ADD SIZ,1(THIS)
MOVE THIS,-1(P) ;RETRIEVE CURRENT BLOCK.
PUSHJ P,RELINK ;AND NOW RELINK ON FRELST.
POP P,SIZ
POP P,THIS
PUSHJ P,GETCOR ;GET THE BLOCK AGAIN, ONLY BIGGER
CORERR <DRYROT -- NEAR CRXXB> ;CAN'T HAPPEN
POP P,-2(THIS) ;GET POINTER WORD BACK
AOS (P) ;SUCCESS
POPJ P, ;BUFRST DONE BY GETCOR
YESINC: AOS (P) ;REPORT SUCCESS
IFN DEBCOR,<
SKIPE PRTCOR
PUSHJ P,CORPRT
>
JRST BUFRST
MAYBE: ADDI TEMP,3(LAST) ;GET TOP OF NEXT BLOCK AND SEE
CAMGE TEMP,TOP(USER) ;IF IT IS THE TOP ONE.
JRST NOTENUF ;NO -- FAIL UTTERLY.
JUMPE FF,YESINC ;GOT IT IF ONLY GOING TO HERE.
PUSH P,SIZ ;SAVE AMOUNT REQUESTED.
MOVEI SIZ,-3(TEMP) ;THIS IS THE SIZE OF THE BLOCK WE
SUB SIZ,LAST ;KNOW WE CAN GET.
MOVN TEMP,SIZ
ADDM TEMP,(P) ;(P) NOW HAS EXTRA REQUIRED.
PUSHJ P,CRXXB ;AND WE DO SOO
CORERR <DRYROT NEAR MAYBE> ; CAN'T HAPPEN.
POP P,SIZ ;RETRIEVE SIZE.
MOVNI FF,1 ;SINCE CRXXB DESTROYED IT.
JRST INCR ;AND GO THROUGH AGAIN
NOTENUF:
SUBI TEMP,3(LAST) ;UNDO WHAT WAS DONE ABOVE
SKIPA SIZ,TEMP ;CAN'T DO ALL, BUT CAN DO THIS MUCH
NONEATALL:
MOVEI SIZ,0 ;CAN'T DO ANYTHING
MOVEM SIZ,BUFACS+SIZ(USER)
JRST BUFRST
SUBTTL CORREL
HERE(CORREL)
IFN DEBCOR,<
SKIPE PRTCOR
TERPRI <CORREL: >
>
SKIPN USER,GOGTAB ;MUST BE SET UP HERE
CORERR <DRYROT -- CORREL CALLED WITH INITIALIZED WORLD>
GLOB <
TRNN THIS,400000 ;IS IT SECOND SEGMENT ADDRESS?
JRST NOSGR ;NO
MOVEI USER,GLUSER ;USE THIS ONE.
AOSE CORLOK ;SEE IF WE CAN GET IN.
JRST [SOS CORLOK
PUSHJ P,WAITQQ
JRST .-1]
NOSGR:
>;GLOB
CMU <
GGAS <
TRNN THIS,400000 ;IS IT SECOND SEGMENT ADDRESS?
JRST NOSGR ;NO
↑↑CORE2R:
IFN DEBGAS,<SKIPE PRTGAS
TERPRI <CORREL: >
>
MOVEI USER,GLUSER ;USE THIS ONE.
AOSE CORLOK ;SEE IF WE CAN GET IN.
JRST [SOS CORLOK
MOVEI TEMP,0
CALLI TEMP,31
JRST .-1]
NOSGR:
>;GGAS
>;CMU
PUSHJ P,JUSTSAVE ;SAVE ACS
SUBI THIS,2 ;USER THINKS IT STARTED 2 PAST
MOVN SIZ,1(THIS) ;SIZE OF THIS BLOCK
CMU <
IFN DEBGAS,<
TRNE THIS,400000
SKIPN PRTGAS
JRST RELPRT
PRINT < LOC=>
MOVE TEMP,THIS
OCTPNT TEMP
PRINT < SIZ=>
OCTPNT SIZ
PRINT < MODULE=>
OCTPNT (TEMP)
RELPRT:
>;IFN DEBGAS
>;CMU
MOVE LAST,SIZ ;ADDRESS OF UPPER
ADD LAST,THIS ; NEIGHBOR
CAMGE THIS,LOWC(USER) ;IS ADDRESS IN RANGE?
CORERR <DRYROT -- ADDR TO CORREL TOO LOW>
CAME THIS,LOWC(USER) ;CAN THERE BE A LOWER BLOCK
SKIPGE -1(THIS) ; AND IF SO, IS IT FREE?
JRST UPPET ; NO, LOOK FOR UPPER BLOCK
HRRZ THIS,-1(THIS) ;PTR TO LOWER BLOCK
PUSHJ P,UNLINK ;UNLINK IT FROM LIST
ADD SIZ,1(THIS) ;INCREASE SIZE
UPPET: CAMLE LAST,TOP(USER)
CORERR <DRYROT -- ADDR TO CORREL TOO HIGH>
CAME LAST,TOP(USER) ;IS THERE AN UPPER BLOCK?
SKIPGE 1(LAST) ;AND IF SO, IS IT FREE?
JRST LNKRET ; NO, RELINK AND GO AWAY
UPPR: PUSH P,THIS
HRRZ THIS,LAST ;THIS PTR TO UPPER NEIGHBOR
PUSHJ P,UNLINK ;GET IT OUT
ADD LAST,1(THIS) ; INCREASE EXTENT
ADD SIZ,1(THIS) ; AND TOTAL SIZE
POP P,THIS ; GET HEADER POINTER BACK
LNKRET:
GLOB <
CAIN USER,GLUSER
JRST LNKRT ;IF SEC SEGMENT, NEVER SHRINK
>;GLOB
SKIPL TEMP,NOSHRK(USER) ;If NOSHRK(USER) is:
CAMG LAST,JOBREL ; <0, CORREL should not reduce core;
JRST LNKRT ; >0, its RH indicates the amount of
CMU <
GGAS <
CAIN USER,GLUSER ;HI GUY?
JRST [HRRZ TEMP,JOBHRL ;YES
CAIG LAST,(TEMP) ;HIEST BLOCK?
JRST LNKRT ;NOPE
HRLZI TEMP,=1023(THIS) ;STICK IN HI SEG HALF
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT)
CALL6 (TEMP,CORE)
ERR <DRYROT --CORSER&LNKRET>
MOVNS TEMP
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT)
HRROS JOBHRL ;HACK SO SAVE WON'T A HI SEG
HRRZ LAST,JOBHRL
JRST CORCUT]
>;GGAS
>;CMU
JUMPN TEMP,.+2 ; free space which should be
MOVEI TEMP,=2046 ; protected from release;
HRRZS TEMP ; =0, at least 2K should be protected.
CAIGE TEMP,4 ;Only the first and third alternatives
MOVEI TEMP,4 ; were previously available.
CAMGE SIZ,TEMP ;Don't bother if there is already
JRST LNKRT ; less free space available than
ADDI TEMP,(THIS) ; desired
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT)
NOTENX <
CALL6 (TEMP,CORE)
ERR <DRYROT --CORSER&LNKRET>
>;NOTENX
TENX <
HRRZM TEMP,JOBREL ;SEE COMMENT @ NODDT ABOVE
>;TENX
MOVNS TEMP
TRPCAL (SIZ,TEMP,X11,X11,.EXPINT)
MOVE LAST,JOBREL ; AND 2) ADJUST BLOCK TO INDICATE
CMU <
GGAS <
CORCUT:
>;GGAS
>;CMU
ADDI LAST,1
MOVEM LAST,TOP(USER) ;AND RECORD NEW RESULTS.
MOVE SIZ,LAST ; THE CHANGE BEFORE RELINKING
SUB SIZ,THIS
LNKRT:
PUSHJ P,RELINK ;PUT IT BACK
IFN DEBCOR,<
SKIPE PRTCOR
PUSHJ P,CORPRT
>
JRST GETRST ;AND GO AWAY
SUBTTL CORPRT, CORBIG
IFN DEBCOR,<
↑CORPRT:
SETZM TOTFRE# ;TOTAL FREE STORAGE COUNT
TERPRI <FREE STORAGE: >
PUSH P,LPSA
MOVE USER,GOGTAB ;THIS STUFF IS DEBUGGING
CMU <
GGAS <
MOVEI USER,GLUSER
>;GGAS
>;CMU
MOVEI LPSA,FRELST(USER) ;JUNK FOR CORGET AND FRIENDS
CPLUP: HRRZ LPSA,(LPSA) ;IT SHOULD BE INTUITIVELY
JUMPE LPSA,DUNNN ;OBVIOUS
PRINT <START = >
OCTPNT LPSA
MOVE TEMP,1(LPSA)
ADDM TEMP,TOTFRE
PRINT < SIZE = >
OCTPNT TEMP
ADD TEMP,LPSA
PRINT < END = >
OCTPNT TEMP
TERPRI
JRST CPLUP
DUNNN:
PRINT <TOTAL FREE SIZE = >
OCTPNT TOTFRE
CMU <
GGAS <
JRST GG.DBP ;HACK TO MAKE COND ASSY EASIER (UGH)
>;GGAS
>;CMU
SETOM PRTCOR
TERPRI
CAMLE THIS,JOBREL
JRST DUNMOR
TERPRI <THIS BLOCK: >
PRINT <"THIS" = >
MOVE TEMP,THIS
OCTPNT TEMP
PRINT < C-SIZE = >
HRRZ TEMP,SIZ
OCTPNT TEMP
CAML THIS,JOBREL
JRST DUNMOR
HRREI LPSA,-2(THIS)
JUMPLE LPSA,DUNMOR
PRINT < BLOCK-SIZE = >
MOVN TEMP,1(LPSA)
OCTPNT TEMP
CMU <
GGAS <
GG.DBP:
TERPRI
PRINT <LASTAL = >
OCTPNT LASTAL
PRINT < HI BND = >
MOVE TEMP,GAS
JUMPE TEMP,.+3
OCTPNT -1(TEMP)
TERPRI
>;GGAS
>;CMU
DUNMOR: TERPRI
POP P,LPSA
TTCALL 11,
TTCALL TEMP
TERPRI
POPJ P,
>
CMU <
IFN GASSW,<
INTERNAL GASINI,MAKEGA,GASTAT
TEMP2←←13
GASLOK:-1 ;CRITICAL SECTION LOCK, ONE CUSTOMER AT A TIME
LASTAL: 0 ;INDEX OF FIRST WORD OF HIEST ALLOCATED BLOK
IFN DEBGAS,<PRTGAS: 0 ;SWITCH TO ENABLE DEBUGGING
INTERNAL PRTGAS
>;IFN DEBGAS
HERE(GASINI)
SETZM GAS
SETZM GLBPNT
SETOM CORLOK
SETOM GASLOK
IFN DEBGAS,<
SKIPE PRTGAS
TERPRI <GASINIT:>
>;IFN DEBGAS
POPJ P,
HERE(MAKEGA)
SKIPG TM,-3(P)
ERR <MAKEGAS: NEGATIVE MODULE #>,1
AOSE GASLOK ;ONE AT A TIME.
JRST [
MOVEI A,0
CALLI A,31
JRST .-1] ;COME BACK LATER.
IFN DEBGAS,< SKIPE PRTGAS
TERPRI <MAKEGAS:>
>
SKIPN GASAD,GAS ;GET ADDRESS OF ARRAY IS IT ZERO.
JRST INITGS ;ZERO. GO INITIALIZE IT.
TKGS01: SKIPG SIZ,-2(P) ;GET SIZE REQUEST.
JRST GASRTN ;NOT POSITIVE, &O RETURNING.
PUSHJ P,CORE2 ;GO ALLOCATE CORE.
ERR <MAKEGAS: NO CORE>
SUBI THIS,(GASAD) ;COMPUTE INDEX.
MOVEM THIS,@-1(P) ;SET IT TO RETURN TO CALLER.
CAML THIS,LASTAL ;HAVE WE EXTENDED THE ARRAY
JRST [MOVEM THIS,LASTAL ;YUP--REMEMBER IT
ADDI THIS,-1(SIZ) ;NEW UPPER BOUND
MOVEM THIS,-3(GASAD) ;SAVE UPR BND IN HEADER
HRRM THIS,-1(GASAD) ; " TOTL SIZ " "
JRST .+1 ]
TKGS03:
IFN DEBGAS,<SKIPE PRTGAS
PUSHJ P,CORPRT
>;IFN DEBGAS
SETOM GASLOK ;RESET LOCK.
SUB P,[XWD 4,4] ;STEP BACK IN STACK.
JRST @4(P) ;AND LEAVE.
INITGS: MOVEI SIZ,5 ;NEED 5 WORDS FOR DESCRIPTOR.
PUSHJ P,CORE2 ;GET THEM.
ERR <MAKEGAS: NO CORE>
SETZM 1(THIS) ;LOWER BOUNDS = 0.
SETZM 2(THIS) ;UPPER BOUNDS = 0.
MOVEI TEMP,1
MOVEM TEMP,3(THIS) ;MULT = 1.
HRLI TEMP,1
MOVEM TEMP,4(THIS) ;#DIMS,,SIZE
MOVEI GASAD,5(THIS) ;ADDRESS OF START OF ARRAY.
MOVEM GASAD,(THIS) ;SET AS BASE WORD.
MOVEM GASAD,GAS ;SET AS GAS.
SETZM LASTAL ;ZERO LAST-ALLOC. WORD.
JRST TKGS01 ;CONTINUE.
GASRTN: MOVE THIS,@-1(P) ;GET INDEX.
CAMN THIS,LASTAL ;END OF ARRAY?
JRST [MOVEI TEMP,-3(THIS) ;YES
ADDI TEMP,(GASAD) ;ADDR OF LAST WORD OF PREV
TGAS8: MOVEI TEMP2,-1(TEMP) ;SAVE
SKIPL TEMP,(TEMP)
JRST [MOVEI TEMP,-1(TEMP)
JRST TGAS8] ;THIS IS FREE, TOO.
SUBI TEMP2,(GASAD) ;CALC HIEST INDEX
MOVEM TEMP2,-3(GASAD) ;SAVE UPR BND
HRRM TEMP2,-1(GASAD) ;SAVE TOTAL SIZE
HRRZS TEMP ;CLEAR OUT SIGN BIT
SUBI TEMP,-2(GASAD) ;INDEX OF 1ST WRD OF BLOK
MOVEM TEMP,LASTAL ;REMEMBER IT
JRST .+1]
TKGS06: ADDI THIS,(GASAD) ;MAKE IT AN INDEX
PUSHJ P,CORE2R ;RELEASE CORE.
JRST TKGS03 ;GO LEAVE.
HERE(GASTAT)
TERPRI <GAS PROFILE:>
MOVEI USER,GLUSER ;HI SEG
AOSE GASLOK ;CRITICAL SECTION
JRST [MOVEI TEMP,0
CALLI TEMP,31 ;DISMISS
JRST .-1]
SKIPN TM,GAS ;WHERE IT IS
JRST NOGAS
PRINT <GAS[0] IS AT '>
OCTPNT TM
PRINT < JOBHRL='>
OCTPNT JOBHRL
PRINT < LASTAL=>
DECPNT LASTAL
PRINT < HIEST=>
DECPNT -3(TM)
TERPRI <
START LENGTH MODULE PREV NEXT>
MOVEI PREV,0 ;TO ACCUMULATE AMOUNT FREE
MOVEI NEXT,0 ;" " " IN USE
HRRZ LAST,JOBHRL ;THE STOPPING ADDRESS
AOS TM ;ADDRESS OF FIRST BLOCK IN GAS
STLP: MOVE TEMP,TM
SUB TEMP,GAS
DECPNT TEMP ;STARTING INDEX
PRINT < >
MOVM SIZ,1(TM) ;ABSOLUTE LENGTH
DECPNT SIZ
PRINT < >
SKIPL 1(TM) ;FREE?
JRST STFREE ; YES
DECPNT (TM) ;MODULE NUMBER
ADD NEXT,SIZ ;ACCUMULATE AMOUNT IN USE
JRST STNEXT ;GO GET ANOTHER
STFREE: ADD PREV,SIZ ;ACCUMULATE AMOUNT FREE
PRINT < >
HLRZ TEMP,(TM) ;PREV
SKIPE TEMP
SUB TEMP,GAS ;COMPUTE THE INDEX
DECPNT TEMP
PRINT < >
HRRZ TEMP,(TM) ;NEXT
SKIPE TEMP
SUB TEMP,GAS ;ITS INDEX
DECPNT TEMP
STNEXT: TERPRI
ADD TM,SIZ ;ADDR OF NEXT BLOCK
CAMG TM,LAST ;DONE?
JRST STLP ; NO
PRINT <
AMOUNT IN USE=>
MOVE TEMP,NEXT
DECPNT TEMP
PRINT < FREE=>
DECPNT PREV
STATOU: TERPRI
SETOM GASLOK ;LEAVE CRIT SECTION
POPJ P,
NOGAS: TERPRI <THE TANK IS DRY!>
JRST STATOU
>;IFN GASSW
>;CMU
HERE(CORBIG) SKIPN USER,GOGTAB
CORERR <CORBIG: INITIALIZED WORLD>
MOVEI SIZ,0 ;"ZERO-LENGTH" BLOCK
MOVEI THIS,FRELST(USER)
BIGLUP: HRRZ THIS,(THIS)
JUMPE THIS,BIGDUN ;END OF FREELIST?
CAMGE SIZ,1(THIS)
MOVE SIZ,1(THIS) ;FIND MAX
JRST BIGLUP
BIGDUN: SUBI SIZ,3 ;WHAT HE SEES
POPJ P,
>;NOLOW
ENDCOM (COR)