.TITLE	BASIS
	.IDENT	/BCPL04/
	.SBTTL	HEADER AND MACROS
;
; BASIC LIBRARY FUNCTIONS FOR STORE MANAGEMENT
; AND FILE HANDLING.
;
; JEREMY HOLDEN
; 5 FEB 76
;
; MACRO DEFINITIONS
;
.MCALL	CALL,RETURN
.MACRO	SAVE	LIST
	.IRP	X,<LIST>
	MOV	X,-(SP)
	.ENDR
.ENDM	SAVE
.MACRO	UNSAVE	LIST
	.IRP	X,LIST
	MOV	(SP)+,X
	.ENDR
.ENDM	UNSAVE
;
; FIXED LOCATIONS.
; THESE ARE AT THE BOTTOM OF VIRTUAL ADDRESS SPACE.
; LOCATION 0 USED BY EXEC, & 2,4,6,10 BY FILES-11
;
	.ASECT
	.=12
TOPCOR::0
FREEQ:	0
FILEQ:	0
	.PSECT
	.PAGE
	.SBTTL	STORE MANAGEMENT
;
; TWO ROUTINES, HEAP AND UNHEAP ARE PROVIDED FOR THE DYNAMIC
; ALLOCATION OF CORE. THE ROUTINES ALLOCATE CORE DOWNWARDS FROM
; TOPCORE, AND RETURN IT TO A FREE CHAIN. CORE IS ALLOCATED IN
; BLOCKS OF AT LEAST 6 BYTES, THE BOTTOM WORD OF THE BLOCK BEING
; RESERVED FOR THE SIZE OF THE BLOCK. THE FREE CHAIN IS A DOUBLY
; LINKED LIST.
;
;=================================================================
;	NADD
;=================================================================
; THIS ROUTINE ADDS THE NODE ADDRESSED BY R0 AFTER THE NODE
; ADDRESSED BY R1. NO REGISTERS ARE CHANGED.
;
NADD:	SAVE	R1
	MOV	R1,2(R0)
	MOV	(R1),R1
	MOV	R1,(R0)
	BEQ	1$
	MOV	R0,2(R1)
1$:	UNSAVE	R1
	MOV	R0,(R1)
	RETURN
;
;=================================================================
;	NDEL
;=================================================================
; THIS ROUTINE REMOVES NODE ADDRESSED BY R0 FROM CHAIN. NO REGISTERS
; ARE AFFECTED.
;
NDEL:	SAVE	R1
	MOV	(R0),R1
	BEQ	1$
	MOV	2(R0),2(R1)
1$:	MOV	R1,@2(R0)
	UNSAVE	R1
	RETURN
;
;=================================================================
;	HEAP
;=================================================================
; THIS ROUTINE IS ENTERED WITH THE NUMBER OF WORDS REQUIRED IN R0.
; IT FIRST SEARCHES THE FREE CHAIN, LOOKING FOR FIRST BLOCK LARGE
; ENOUGH (VIZ A VIZ KNUTH), ELSE ALLOCATES IT FROM TOP OF CORE.
; ADDRESS OF BLOCK IS RETURNED IN R0.
;
HEAP::	SAVE	R1
	INC	R0		; ALLOW 1 WORD FOR SIZE
	ASL	R0		; MAKE INTO BYTES
	CMP	R0,#6		; TOO SMALL?
	BHIS	1$		; NO, CARRY ON.
	MOV	#6,R0		; YES, GIVE HIM 2 WORDS
1$:	MOV	R0,R1		; SAVE SIZE
	MOV	#FREEQ,R0	; GET FREE CHAIN ADDRESS
2$:	MOV	(R0),R0		; GET NEXT ON CHAIN
	BEQ	5$		; IS THERE ANY?
	CMP	-2(R0),R1	; YES, BUT IS IT BIG ENOUGH?
	BLO	2$		; NO, TRY THE NEXT ONE.
	CALL	NDEL		; TAKE IT OFF THE CHAIN
	SAVE	R2		; NEED MORE WORKSPACE
	MOV	-2(R0),R2	; GET SIZE OF BLOCK
	SUB	R1,R2		; FIND HOW MUCH SPARE SPACE
	CMP	R2,#6		; ENOUGH TOO LEAVE BEHIND?
	BLO	3$		; NO, DON'T BOTHER THEN
	MOV	R1,-2(R0)	; MARK SIZE OF OUR BLOCK
	SAVE	R0		; SAVE ADDRESS OF BLOCK
	ADD	R1,R0		; R0 := ADDRESS OF EXCESS BLOCK
	MOV	R2,-2(R0)	; MARK SIZE OF EXCESS
	MOV	(SP),R1		; R1 = ADDRESS OF ALLOCATED BLOCK
	MOV	2(R1),R1	; R1 = PREDECESSOR
	CALL	NADD		; LINK EXCESS BACK ON CHAIN
	UNSAVE	R0		; RESTORE ADDRESS OF BLOCK
3$:	UNSAVE	R2
4$:	UNSAVE	R1
	RETURN
5$:	SUB	R1,@#TOPCORE	; NO FREE, ALLOCATE FROM TOP
	MOV	@#TOPCORE,R0	; GET ADDRESS OF BLOCK
	MOV	R1,(R0)+	; MARK ITS SIZE
	BR	4$		; EXIT
;
;=================================================================
;	UNHEAP
;=================================================================
; RETURNS BLOCK OF CORE ADDRESSED BY R0 TO FREE CHAIN. IT THEN TRIES
; TO CONCATENATE ADJACENT BLOCKS ON CHAIN, AND THEN TRIES TO RETURN
; ANY CHAIN POSSIBLE TO CORE.
;
UNHEAP::SAVE	R1
	MOV	#FREEQ,R1
1$:	TST	(R1)		; AT END OF CHAIN?
	BEQ	2$		; YES, ADD IT THERE.
	MOV	(R1),R1		; MOVE ALONG CHAIN
	CMP	R0,R1		; HIGHER OR LOWER?
	BLO	1$		; LOWER, TRY NEXT ON CHAIN
	MOV	2(R1),R1	; HIGHER, BACK UP ONE
2$:	CALL	NADD		; ADD IT TO CHAIN
	CALL	CONCAT		; TRY CONCATENATING PREDECESSOR
	MOV	R0,R1		; NOW MOVING ALONG
	TST	(R0)		; AT END OF CHAIN?
	BEQ	4$		; YES, TRY ADDING TO CORE
	MOV	(R0),R0		; GET SUCCESSOR
	CALL	CONCAT		; TRY CONCATENATING WITH IT.
3$:	UNSAVE	R1
	RETURN
4$:	TST	-(R1)		; R1 IS TRUE ADDRESS OF NODE
	CMP	R1,@#TOPCORE	; IS IT BOTTOM OF HEAP?
	BNE	3$		; NO, GO AWAY
	CALL	NDEL		; YES, UNCHAIN IT
	ADD	(R1),@#TOPCORE	; RETURN SPACE
	BR	3$		; ALL DONE.
CONCAT:	SAVE	R0		; R0 IS NODE
	ADD	-2(R0),R0	; GET ADDRESS OF NEXT BLOCK UP
	CMP	R0,R1		; IS IT PREDECESSOR?
	BNE	1$		; NO, FORGET IT
	CALL	NDEL		; YES, REMOVE PREDECESSOR
	UNSAVE	R0		; GET OUR ADDRESS BACK
	ADD	-2(R1),-2(R0)	; ADD HIS SPACE TO OURS
	RETURN
1$:	UNSAVE	R0
	RETURN
	.PAGE
	.SBTTL	FILE HANDLING
;
; THE FILE HANDLING ROUTINES SUPPORT RECORD BASED I/O USING VARIABLE
; LENGTH RECORDS IN MOVE MODE WITH THE FD.CR OPTION [CRLF ADDED ON
; OUTPUT TO CARRIAGE CONTROL DEVICE]
; FDB SPACE IS ALLOCATED ON THE HEAP AND THE FDBS ARE CHAINED ON A
; DOUBLY LINKED LIST. LUNS ARE ALLOCATED SEQUENTIALLY FROM 2 UPWARDS
; [1 BEING RESERVED FOR GCML ROUTINES]
	.MCALL	FDOF$L,FCSBT$,FSRSZ$
	FDOF$L
	FCSBT$
	FSRSZ$	0
;
;=================================================================
;	OPEN
;=================================================================
; THIS ROUTINE TAKES FIVE PARAMETERS,
; R0 = DATASET DESCRIPTOR (OR 0)
; R1 = DEFAULT FILE NAME BLOCK (OR 0)
; R2 = ZERO/NONZERO INPUT/OUTPUT
; R3 = BUFFER ADDRESS
; R4 = BUFFER SIZE
; IT ALLOCATES FDB, INITIALIZES IT AND TRIES TO OPEN FILE. C-BIT
; SET ON EXIT IF OPEN FAIL. ON EXIT R0 CONTAINS ADDRESS OF FDB.
;
	.MCALL	FDAT$R,FDRC$R,FDOP$R,FDBF$R,OPEN$R,OPEN$W
OPEN::	SAVE	<R1,R0>
	MOV	#1,R1		; FIRST WE FIND FIRST UNUSED LUN
1$:	INC	R1		; STARTING WITH LUN 2
	MOV	#FILEQ,R0	; GET FDB CHAIN
2$:	MOV	(R0),R0		; MOVE ALONG CHAIN
	BEQ	3$		; ARE WE AT END OF CHAIN?
	CMPB	F.LUN+4(R0),R1	; NO, IS THIS OUR LUN?
	BEQ	1$		; YES, IN USE SO TRY NEXT ONE
	BR	2$		; NO, TRY NEXT ON CHAIN
3$:	MOV	#S.FDB/2+2,R0	; ALLOCATE SPACE FOR FDB,
	CALL	HEAP		; + 2 WORDS FOR CHAIN
	SAVE	<R1,R0>		; PREPARE TO CLEAR FDB
	MOV	#S.FDB/2+2,R1	; SIZE IN WORDS
7$:	CLR	(R0)+
	SOB	R1,7$
	UNSAVE	R0		; RESTORE FDB ADDRESS
	MOVB	(SP)+,F.LUN+4(R0)	; SET LUN IN FDB
	MOV	#FILEQ,R1	; ADD IT TO CHAIN
	CALL	NADD		; OF FDBS
	CMP	(R0)+,(R0)+	; POINT TO FDB
	FDAT$R	,#R.VAR,#FD.CR	; FILL IN FILE DATA SECTION
	FDRC$R	,,R3,R4		; FILE RECORD SECTION
	FDOP$R	,,(SP)+,(SP)+	; FILE OPEN SECTION
	FDBF$R	,,#1000
	TST	R2		; INPUT OR OUTPUT?
	BNE	4$		;
	OPEN$R			; OPEN FOR INPUT
	BR	5$
4$:	OPEN$W			; OPEN FOR OUTPUT
5$:	BCC	6$		; OPEN FAIL?
	CMP	-(R0),-(R0)	; YES, GET CHAIN
	CALL	NDEL		; UNHOOK THE FDB
	CALL	UNHEAP		; RETURN SPACE
	SEC			; SIGNAL FAILURE
6$:	RETURN
;
;=================================================================
;	CLOSE
;=================================================================
; TAKES ONE PARAMETER,
; R0 = FDB
; CLOSES THE FILE AND RECLAIMS STORAGE
;
	.MCALL	CLOSE$
CLOSE::	CLOSE$
	CMP	-(R0),-(R0)	; POINT TO CHAIN
	CALL	NDEL		; UNCHAIN
	CALL	UNHEAP		; RETURN STORAGE
	RETURN
;
;==================================================================
;	ABORT
;==================================================================
; NO PARAMETERS. 
; ATTEMPT TO CLOSE ALL FILES
;
ABORT::	MOV	#FILEQ,R1	; GET FDB CHAIN
1$:	MOV	(R1),R1		; MOVE ALONG CHAIN
	BEQ	2$		; AT END?
	MOV	R1,R0
	CMP	(R0)+,(R0)+	; NO, POINT TO FDB
	CALL	CLOSE		; CLOSE IT
	BR	1$		; TRY SOME MORE
2$:	RETURN
	.END