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)
END