.TITLE	CLRCOR
.IDENT	\V02.03\

.SBTTL	CLRCOR		CLEAR MEMORY

;++
; FUNCTIONAL DESCRIPTION:
;	This routine is called to initialize
;	the free storage area and the top of core pointer.  The top of core
;	is low enough to accomidate several handlers.  The USR will be swapped
;	in over the pure-code for maximum space.   If APL is running on RSTS
;	the device handlers and the USR are never in user core so no space is
;	left.  The start address (at absolute location 40) is set to 'START',
;	so that when the program is started, this routine won't be called.
;
; CALLING SEQUENCE:
;	CALL	CLRCOR
;	  ..or..
;	CALL	CLRCO1
;
; INPUTS:
;	NONE
;
; OUTPUTS:
;	NONE
;
; ROUTINES CALLED:
;	NONE
;
; SIDE EFFECTS;
;	The Workspace is cleared and initialized
;--
	.PSECT	CODE

CLRCO1::
;+
; RESET ALL CHANNELS (Except Overlay Channel)
;-
    .IF NE RSX ! RT11
	CALL	FRESET		;RESET CHANNELS 1.-12.
	MOV	#CHAN13,R2	;ALSO RESET
	CALL	RESCHN		;   UTILTY CHANNEL #1.
	MOV	#CHAN14,R2	;ALSO RESET
	CALL	RESCHN		;   UTILTY CHANNEL #2.
    .IFF
	MOV	P.MSIZ,XRB	;Reset Core Size
	.CORE			;Call RSTS to do it
	MOVB	#RSTFQ,FQ.FUN	;Reset Channels
	CLR	FQ.FIL		;Reset All of them
	CALFIP			;Call RSTS to do it
	BIC	#SY.OPN,SYSTAT	;Nothing Open Yet
    .ENDC

CLRCOR::
;+
; READ IN A CLEAR CHUCK OF VARIABLE CORE
;-
    .IF NE RSX			;RSX -  Load in Segment
	MOV	#CLRSEG,R0	;POINT TO CLEAR WS SEGMENT
	CALL	$LOAD		;FORCE THE DATA INTO CORE
;	BCS	14$		;EVERYTHING WENT WRONG
;	MOV	#ROTSEG,R0	;Point to Root of 2nd Tree
;	CALL	$LOAD		;Load it in
	BCC	1$		;Everything is OK
14$:
	.IF GT RSX
	EXIT$S			;Terminate
	.IFF
	.EXIT			;Terminate
	.ENDC
    .IFF
	.IF NE RT11		;RT-11 -like.
	MOV	LOWCOR,R0	;Delete the Ws Area for Re-Allocation
	BEQ	14$		;No, so it's alright
	MOV	#VARBLE+10,R0	;Get only a little space
	.SETTOP			;Drop The Extra
	CLR	LOWCOR		;Clear the Flag

14$:	CALL	CLRWS1		;Bring in Micro-Overlay
	CALL	CLRWS2		;Force the WS in by Overlay Call
	
	.IFF
	BIT	#SY.OPN,SYSTAT	;File Already Open?
	BNE	14$		;Yes

10$:	MOV	#CLRFIL+1,R0	;Point to FIRQB-Type File Name
	MOV	#FQ.FUN,R1	;Point to Where to load in the FIRQB
	MOV	#29.,R2		;This Many Bytes

11$:	MOVB	(R0)+,(R1)+	;Copy Name to FIRQB
	SOB	R2,11$		;All of it
	.CHAIN			;Run the "Clear WS" Image
12$:	.EXIT			;Die!

13$:	BIS	#SY.OPN,SYSTAT	;Say Clear File Now Open

14$:	MOV	FQ.SIZ,R4	;Get the File Size
	MOV	R4,R3		;Copy it for Work
	ADD	#3.,R3		;Cheat
	ASR	R3		;   and Round
	ASR	R3		;      to KWord
	CMP	R3,P.MSIZ	;Is it TOO Small?
	BLT	12$		;Yes, Cannot be WS
	CMP	R3,P.SIZE	;Is it TOO Big?
	BGT	12$		;Yes, is an Error
	PUSH	<OMODE,XRB>	;Save Terminal Type, Entry Flags

	MOV	#FQ.PPN,R0	;Point to PPN of Start File
	MOV	#CLRFIL+4.,R1	;Point to Clear WS Name Image
	MOV	#4.,R2		;Loop Count
15$:	CMP	(R0)+,(R1)+	;The Same?
	BNE	16$		;Nope, use its own Name
	SOB	R2,15$		;Loop for PPN, Name, and Extension
	MOV	#FQ.NAM,R0	;Point to Name Field
	MOV	(PC)+,(R0)+	;Copy "CLR"
	.RAD50	/CLR/		;  (would I lie to you?)
	MOV	(PC)+,(R0)+	;Also Copy " WS"
	.RAD50	/ WS/		;  (Hence, the WS Name is "CLR WS")

16$:	.NAME			;Set the Program NAME
	MOV	R3,XRB		;New Size of Low Core
	.CORE			;Exactly this much Space
	DEC	R4		;Ignore the 1st Block
	ASH	#9.,R4		;Convert Block Size to Bytes

	MOV	#XR.TIM,R0	;Point to Time in XRB
	MOV	#2.,-(R0)	;Reading from location 1000(8) of File
	MOV	#15.*2,-(R0)	;Channel 15.
	MOV	#1000,-(R0)	;Beginning of Buffer
	CLR	-(R0)		;Must Be Zero
	MOV	R4,-(R0)	;Buffer Size
	.READ			;Read it in
	TSTB	IOSTS		;Any Errors?
	BNE	12$		;Yes, Die
	POP	R1		;Get the Entry Flags
	BLT	17$		;CCL Entry, Don't Handle /DETACH or /SIZE
	BIT	#1,R1		;.RUN (Someone Else) or .CHAIN (Clear or Load)
	BEQ	17$		;Someone Else, I guess
	MOV	(SP),OMODE	;Restore Terminal Type
17$:	TST	(SP)+		;Skip this Garbage
	MOV	#15.*2,FQ.FIL	;Channel 15. (Times 2 for RSTS)
	MOVB	#CLSFQ,FQ.FUN	;Close Function
	CALFIP			;FIP Processor
	.ENDC
    .ENDC

1$:	BIC	#SY.BAD!SY.OPN,SYSTAT	;WS no longer Possibly Bad

;+
; NOW TO INITIALIZE WHAT WE READ IN
;-
    .IF GE RSTS
	.IF NE RSX
	SUB	#32.,SP		;SPACE FOR PARTITION PARAMETERS
	MOV	SP,R1		;POINTER IN R1
	GTSK$S	R1		;GET THE PARAMETERS
	MOV	G.TSTS(R1),R0	;GET THE SIZE
	ADD	#32.,SP		;SKIP THE GARBAGE
	SUB	#2.,R0		;MINUS THE HIGH LOCATION
	BIC	#1.,R0		;JUST IN CASE
	.IFF
	MOV	#START,@#40	;Don't Come Here Again
	MOV	#ERROR,@#34	;Set Trap Vector
	CLR	@#36		;Priority 0
	MOV	#-2,R0		;Ask For All Core Possible
	.SETTOP			;And Tell RT How Much to Grab
	.ENDC
;	MOV	#FREBLK-2,R1	;Get Pointer to Low Core-2
	MOV	#27300,R1	;Use D-Space Length
	MOV	#-1,(R1)+	;PUT IN SAFETY WORD
	MOV	R0,ENDCOR	;SET A POINTER TO TOP OF APL CORE
	MOV	R1,LOWCOR	;LOWER CORE LIMIT
	SUB	R1,R0		;GET LENGTH OF FREE BLOCK
;	ASR	R0		;MAKE A WORD SIZE FOR THE BLOCK
	ROR	R0		;MAKE A WORD SIZE FOR THE BLOCK
	MOV	R0,(R1)+	;SAVE AS SIZE WORD IN BLOCK
	MOV	R1,ROVER	;SET POINTER TO NEXT (ONLY) FREE BLOCK
	MOV	R1,(R1)		;PUT IN LINKS
	MOV	R1,2(R1)	;BOTH OF THEM
	ADD	R0,R1		;MOVE TO END OF BLOCK
	ADD	R0,R1		;DID THIS TWICE BECAUSE IT'S WORD COUNT
	MOV	#-1,-(R1)	;SET UP SAFETY WORD
	MOV	R0,-(R1)	;PUT IN LENGTH AT END
	.IF EQ RSX
	BIS	#RENTR,@#JSW	;Set Restart Bit
	.ENDC
    .ENDC
	TSTB	OMODE		;OMODE already set?
	BGE	2$		;Yes, don't initialize
	CALL	TTINIT		;Initialize the terminal
2$:	RETURN			;And return


.PSECT	TABLES

CHANNEL::
	.WORD	CHAN00,	CHAN01,	CHAN02,	CHAN03,	CHAN04
	.WORD	CHAN05,	CHAN06,	CHAN07,	CHAN08,	CHAN09
	.WORD	CHAN10,	CHAN11,	CHAN12,	CHAN13,	CHAN14
	.WORD	CHANEX
    .IF EQ RSX
	.WORD	CHAN15
    .IFF
CLRSEG:	.BYTE	3,0		;LOAD SYNCHRONOUSLY
	.RAD50	/APLDF2/	;THE VARIABLES (CLEAR IMAGE)

ROTSEG:	.BYTE	3,0		;LOAD SYNCHRONOUSLY
	.RAD50	/ROOT1 /	;   the 2nd tree root
    .ENDC

    .IF LT RSTS
CLRFIL::
	.WORD	0,0,<1*400>+2	;FIRQB Image of
	.RAD50	/CLRWS APC/	;  "SY0:[1,2]CLRWS.APC"
	.WORD	0,0,0,0,0,0,0,0,0
    .ENDC