;
; ***************************
; ONCREK.MAC
; ***************************
;
;
	.MCALL	ULOSTR	ULOEPT	ULOEND
	ULOSTR	START,END
	ULOEPT	ANYRET
	ULOEPT	ALLRET
	ULOEPT	ANYRT1
	ULOEPT	ALLRT1
	ULOEPT	ADDLV1
	ULOEPT	UPDLV1
	ULOEPT	LCKLV1
	ULOEPT	DLTLV1
	ULOEPT	RTNLV1
	ULOEPT	URNLV1
	ULOEPT	NAMLV1
	ULOEND
;
; GLOBALS FOR TKB PATCH REFERENCE
;
	.GLOBL	SRFDPB	VRCDPB
;
; SYSTEM MACRO CALLS
;
	.MCALL	VSDR$	VRCD$	SRDA$S	CLEF$S	DIR$
	.MCALL	WTSE$S	SETF$S	ASTX$S	GMCX$S	SRFR$
	.MCALL	CRAW$S	CRRG$S	DTRG$S	WDBBK$	RDBBK$
	.MCALL	MAP$S	GLUN$S
;
; DEFINE FLOATING REGISTERS USED
;
AC0=%0
;
; DEFINE REGION OFFSETS
;
	ONCDEF	DEF$L
;
; FOLLOWING MACRO IS USED TO GET THE ABSOLUTE ADDRESS OF A LOCALLY
; DEFINED LABEL IN POSITION INDEPENDENT FASHION (NEEDED FOR LOADABLE
; ROUTINES).
;
	.MACRO GTABAD	ADDRES,LOC
	.NTYPE	...ATP,LOC
	.IF	GT	...ATP-5
	MOV	PC,-(SP)
	ADD	#ADDRES-.,(SP)
	MOV	(SP)+,LOC
	.IFF
	MOV	PC,LOC
	ADD	#ADDRES-.,LOC
	.ENDC
	.ENDM	GTABAD
;
;
EVFL	= 1	;DEFINE EVENT FLAG
START:
MCX:	.BLKB	20*4+2	;BUFFER FOR MAPPING CONTEXT
MCXADD:	.WORD	0	;ADDRESS OF SYSRES WINDOW
MCXOFF:	.WORD	0	;OFFSET INTO MCX TO CALC MCXADD
TNUM:	.BLKW	2	;SPACE FOR TERMINAL NAME AND NUMBER
RBUF:	.BLKW	3	;BUFFER FOR RECEIVE BACK FROM DBM
SRFBUF:	.BLKW	8.		;8 WORD BUFFER FOR SEND BY REFERENCE
WDB:	WDBBK$	7,<<$R.TLN+77>/100>,,,,<WS.MAP!WS.WRT!WS.RED!WS.DEL>
RDBFLG:	.WORD	0	;REGION NOT CREATED YET
RDB:	RDBBK$	<<$R.TLN+77>/100>,ONCRGA,GEN,170000
SRFDPB:	SRFR$	ONCDBM
VRCDPB:	VRCD$	ONCDBM,2,2	;DUMMY PARAMS FOR ADD AND LEN SO CAN CALL AGAIN
;
; SUBROUTINES ANYRET AND ALLRET
; LOADABLE BASIC SUBROUTINES
; FOR RETRIEVAL OF RADIATION ONCOLOGY LEVEL1 RECORDS
; BY MATCHING EITHER ANY OR ALL OF THE MATCHING STRINGS
; BASIC CALLS:
;	CALL "ANYRET"(F0,R0,R1,S$,D$,D [,D1$,D1] [,D2$,D2]...)
;	CALL "ALLRET"(        "       "       "       "      )
; WHERE:
;	F0 IS RECORD INCREMENT
;		+1 FOR FORWARD SEARCH
;	R0 IS SEQUENTIAL START INDICATOR
;		0 TO START AT BEGINNING OF FILE
;		<>0 TO USE LAST RETRIEVAL+1 AS START POINT
;	R1 IS VARIABLE TO RECEIVE SUCCESS/FAILURE CODE
;		+ = SUCCESS
;		0 = NONE FOUND (S$ UNCHANGED)
;		- = FAILED DIRECTIVE STATUS
;			-6 (ILLEGAL USER BUFFER) IS USED IF TOTAL LENGTH
;			OF STRINGS EXCEEDS SCRATCH BUFFER SPACE AVAILABLE.
;	S$ IS STRING VARIABLE TO RECEIVE FOUND RECORD
;	D$ D1$ ETC. ARE STRINGS FOR THE MATCH
;	D  D1  ETC. ARE CORRESPONDING COL #'S TO START AT
; NOTE:
;	THE SUM OF THE LENGTHS OF THE MATCHING STRINGS PLUS
;	4* THE NUMBER OF STRINGS SHOULD BE LESS THAN OR EQUAL
;	TO THE SCRATCH BUFFER. IF NOT, THE USER
;	WILL RRECEIVE AN ILLEGAL USER BUFFER CODE RETURN IN R1 (-6).
;
; FOR THE ROUTINE "ANYRET" A MATCH ON ANY STRING (KEY)
;	WILL RETRIEVE THAT RECORD. FOR THE ROUTINE "ALLRET"
;	ALL STRINGS (KEYS) MUST MUST MATCH
;
TYPSAV:	.WORD	0	;PLACE TO SAVE TYPE OF CALL
;
ANYRT1:
ANYRET:	MOV	#<1+400*1>,TYPSAV ;REMEMBER THAT THIS IS "ANY" ON FILE 1
	BR	COMRET
ALLRT1:
ALLRET:	MOV	#<2+400*1>,TYPSAV ;REMEMBER THAT THIS IS "ALL" ON FILE 1
;
COMRET:	JSR	R4,@#GTRGPI	;GET ARGUMENTS IN PI FASHION
	.BYTE	1,1,2,4,0
	.EVEN
	JSR	PC,SETUP	;DO INITIAL SET-UP THINGS
	BCC	1$		;IF OK, BRANCH
	LDCIF	@#$DSW,AC0	;ERROR CODE -> AC0
	ADD	#10,SP		;CLEAN STACK
	BR	COMEN2		;AND FINISH ERROR PROCESSING
;
1$:	MOV	TYPSAV,$R.FCN(R5)	;PUT IN TYPE OF RETRIEVAL
	CLR	$R.L1F(R5)	;CLEAR CURRENT
	CLR	$R.L2F(R5)	;FLAGS
	CLR	$R.L3F(R5)
	LDF	(SP)+,AC0	;GET INCREMENT (AND DIRECTION BY SIGN)
	STF	AC0,SRFBUF+$B.MIS ;AND STORE IN 8 WORD BUFFER (USING 2 WORDS)
	LDF	(SP)+,AC0	;GET RECORD START INDICATION
	CFCC
	BNE	5$		;IF NON-ZERO, LEAVE PREVIOUS RFA
	CLR	$R.L1R(R5)	;ELSE CLEAR OUT RFA
	CLR	$R.L1R+2(R5)	;
	CLR	$R.L1R+4(R5)	;(ALL 3 WORDS)
5$:
	MOV	R5,R4		;COPY START ADDRESS OF REGION
	ADD	#$R.BUF,R4	;AND MAKE R4 POINT TO SCRATCH BUFFER
	MOV	#$R.BLN,$R.S1(R5) ;INIT BUFFER LENGTH REMAINING
2$:
	MOV	R4,-(SP)	;SAVE OUR PLACE IN BUFFER
	JSR	PC,REMAP	;MAP BACK TO SYSRES IN CASE ERROR
	JSR	R4,@#GTRGPI	;GET SOME MORE ARGUMENTS
	.BYTE	3,1,0		;STRING AND COL #
	.EVEN
	JSR	PC,MAPREG	;MAP BACK TO REGION
	MOV	(SP)+,R0	;LEN OF STRING -> R0 AGAIN
	MOV	(SP)+,R3	;ADD -> R3
	LDF	(SP)+,AC0	;COL # -> AC0
	MOV	(SP)+,R4	;RESTORE PLACE IN BUFFER
	MOV	R0,R2		;COPY STRING LENGTH
	ADD	#5,R2		;ADD 2 WORDS PLUS ROUND UP
	BIC	#1,R2		;EVEN WORD LEN -> R2
	SUB	R2,$R.S1(R5)	;DECREMENT LEN LEFT
	BLT	7$		;IF NOT ENOUGH, BRANCH
	STCFI	AC0,(R4)+	;STORE COLUMN NUMBER IN SEND BUFFER
	MOV	R0,(R4)+	;PUT AWAY LEN IN SEND BUFFER
	BEQ	4$		;IF ZERO, BRANCH
3$:	MOVB	(R3)+,(R4)+	;MOVE IN THE STRING
	SOB	R0,3$
4$:	INC	R4		;ROUND UP
	BIC	#1,R4		;R5
	JSR	PC,@#SKIP00	;GET NEXT NON-BLANK CHAR -> R2
	DEC	R1		;BACK UP TEXT PTR
	CMPB	R2,#',		;IS NEXT THING A COMMA?
	BEQ	2$		;IF SO, TRY FOR MORE
	JSR	PC,REMAP	;BACK TO SYSRES IN CASE ERROR
	JSR	PC,@#PARCHK	;CHECK FOR AT END
	JSR	PC,MAPREG	;AND NOW MAP REGION AGAIN
	MOV	R5,R3		;BUFFER ADDRESS -> R3 FOR ONE LAST TIME
	CLR	(R4)+		;PUT IN STOPPER
	JMP	COMEND		;AND GO TO COMMON CODE
7$:	MOV	#IE.SPC,R0	;ERROR CODE (ILLEGAL BUFFER) -> R0
COMERR:	LDCIF	R0,AC0		;ERROR CODE -> AC0
	BR	COMEN2		;AND GO FINISH
COMEND:	JSR	PC,SYNC		;GO SEND DATA AND RECEIVE SOME BACK
	TST	R0		;CHECK ON STATUS
	BLT	COMERR		;IF NEG, BRANCH
	LDF	$R.STS(R3),AC0	;RETRIEVED RECORD # -> AC0
COMEN2:
	MOV	SP,R5		;ADD OF RECORD # STORE -> R5
	MOV	R3,-(SP)
	JSR	PC,@#NSTORE	;STORE THE RECORD # OR ERROR CODE
	MOV	(SP)+,R3
	TSTF	AC0		;CHECK IF RECORD # OR ERROR CODE
	CFCC
	BLE	COMEN1		;IF ERROR (NEGATIVE), BRANCH
	ADD	#$R.LV1,R3	;OFFSET TO START OF LEVEL 1 RECORD BUFFER
	ADD	#12,R5		;MOVE R5 UP TO NEXT STORE DATA
	MOV	#$R.LN1,R4	;STRING LEN -> R4
	JSR	PC,@#SSTORE	;STORE THE STRING
COMEN1:	ADD	#24,SP		;CLEAN THE STACK
	JSR	PC,REMAP	;REMAP TO SYSRES
	RTS	PC		;AND RETURN TO CALLING PROGRAM
;
; ENTRY POINTS ADDLV1 AND UPDLV1
; TO ADD A RECORD TO LEVEL 1 DATA FILE THROUGH THE DATA BASE MANAGER
; OR UPDATE AN EXISTING LEVEL 1 RECORD.
;
; BASIC CALL:
;	CALL "ADDLV1"(S$,R)
;	CALL "UPDLV1"(S$,R)
;
; WHERE:
;	S$ = STRING CONTAINING NEW RECORD
;	R  = VARIABLE TO RECEIVE STATUS FROM DATA BASE MANAGER
;
	.ENABL	LSB
ADDLV1:
	MOV	#3+<400*1>,TYPSAV	;ADD TO LEVEL1
	BR	WRTCOM
UPDLV1:
	MOV	#4+<400*1>,TYPSAV	;UPDATE LEVEL1
WRTCOM:
	JSR	R4,@#GTRGPI		;GET STRING TO BE WRITTEN
	.BYTE	3,2,0			;AND ADDRESS FOR RETURN CODE
	.EVEN
	JSR	PC,@#PARCHK		;FINISH PROCESSING ARG LIST
	JSR	PC,SETUP		;DO INITIAL STUFF
	BCC	2$			;IF OK, BRANCH
	LDCIF	@#$DSW,AC0		;ELSE GET BAD CODE -> AC0
1$:	ADD	#4,SP			;PUSH PAST STRING DESCRIPTOR
8$:	JSR	PC,REMAP		;BACK TO SYSRES MAPPING
	MOV	SP,R5			;POINT TO STRING DESCRIPTOR FOR 'R'
	JSR	PC,@#NSTORE		;STORE RESULT
	ADD	#12,SP			;CLEAN STACK
	RTS	PC			;AND RETURN TO BASIC
2$:
	MOV	TYPSAV,$R.FCN(R5)	;GET FUNCTION
	CMPB	TYPSAV,#4		;UPDATE?
	BNE	3$			;IF NOT, BRANCH
	BIT	#$RF.LK,$R.L1F(R5)	;RECORD LOCKED FOR US?
	BNE	4$			;IF NOT, OK
	CLRF	AC0			;ELSE, NO GO (STATUS OF ZERO)
	BR	1$
3$:	CLR	$R.L1F(R5)		;SET NO CONTEXT DEFINED
4$:	MOV	R5,R4			;COPY REGION ADDRESS -> R4
	ADD	#$R.BUF,R4		;NOW POINT TO BUFFER
11$:	MOV	2(SP),R3		;ADDRESS OF STRING
	MOV	(SP),R0			;LENGTH -> R0
	BEQ	6$			;IF ZERO, BRANCH
5$:	MOVB	(R3)+,(R4)+		;MOVE IN STRING
	SOB	R0,5$
6$:	JSR	PC,SYNC			;SEND THE REGION AND WAIT
	TST	R0			;EVERYTHING OK?
	BGE	7$			;IF SO, BRANCH
	LDCIF	R0,AC0			;IF NOT, GET ERROR CODE -> AC0
	BR	1$
7$:
	LDF	$R.STS(R5),AC0		;GET STATUS -> AC0
	BR	1$
;
; ENTRY POINTS LCKLV1 AND DLTLV1
; TO LOCK EXISTING LEVEL 1 CONTEXT FROM OTHER ACCESS
;
; BASIC CALL:
;
;	CALL "LCKLV1"(S)
;	CALL "DLTLV1"(S)
;
; WHERE:
;	S = RETURNED STATUS
;		+ = SUCCESS
;		0 = NO CONTEXT
;		- = ERROR IN PROCESSING REQUEST
;
DLTLV1:
	MOV	#6+<400*1>,TYPSAV
	BR	DLTLCK
LCKLV1:
	MOV	#<5+400*1>,TYPSAV	;SAVE FUNCTION
DLTLCK:
	JSR	R4,@#GTRGPI		;GET ADDRESS OF STATUS
	.BYTE	2,0
	.EVEN
	JSR	PC,@#PARCHK		;FINISH ARG LIST
	JSR	PC,SETUP
	MOV	TYPSAV,$R.FCN(R5)	;PUT IN FUNCTION CODE
	JSR	PC,SYNC			;SEND AND WAIT FOR RESPONSE
	TST	R0			;CHECK FOR FUNCTIONAL ERROR
	BGE	9$			;IF OK, BRANCH
	LDCIF	R0,AC0			;GET ERROR CODE -> AC0
	BR	8$			;AND GO FINISH
9$:	LDF	$R.STS(R5),AC0		;GET STATUS FROM DBM
	BR	8$
	.DSABL	LSB
;
; ENTRY POINTS RTNLV1, URNLV1 AND NAMLV1
;
; BASIC CALL:
;
;	CALL "RTNLV1"(R$,R,S$)
;	CALL "URNLV1"(R$,R,S$)
;	CALL "NAMLV1"(R$,R,S$)
;
; WHERE:
;
;	R$ = STRING CONTAINING RETRIEVAL PARAMETER:
;		RT NUMBER (5 CHARS)
;		UNIT RECORD NUMBER (6 CHARS)
;		PATIENT NAME (UP TO 30 CHARS)
;	R  = VARIABLE TO RECEIVE RETURNED STATUS
;	S$ = STRING VARIABLE TO RECEIVE RETURNED RECORD
;
RTNLV1:
	MOV	#7+<400*1>,TYPSAV
	BR	RETCOM
URNLV1:
	MOV	#8.+<400*1>,TYPSAV
	BR	RETCOM
NAMLV1:
	MOV	#9.+<400*1>,TYPSAV
RETCOM:
	JSR	R4,@#GTRGPI	;GET ARGUMENTS TO FUNCTION
	.BYTE	3,2,4,0
	.EVEN
	JSR	PC,@#PARCHK	;FINISH PROCESSING CLOSE PAREN
	JSR	PC,SETUP	;DO INITIAL STUFF
	BCC	2$		;IF ALL OK, BRANCH
	LDCIF	@#$DSW,AC0	;ERROR CODE -> AC0
	ADD	#4,SP		;PUSH PAST STRING DESCRIPTOR FOR R$
	JMP	COMEN2		;GO TO ERROR FINISH
2$:	CLR	$R.L1F(R5)	;CLEAR STATUS BITS
	MOV	TYPSAV,$R.FCN(R5) ;SAVE FUNCTION CODE
	MOV	R5,R4		;COPY REGION ADDRESS
	ADD	#$R.BUF,R4	;OFFSET TO BUFFER ADDRESS
	CLR	(R4)+		;DUMMY COLUMN NUMBER
	MOV	(SP)+,R0	;STRING LENGTH
	MOV	(SP)+,R3	;STRING ADDRESS
	MOV	R0,(R4)+	;DEPOSIT STRING LENGTH
	BEQ	4$		;IF ZERO, NO STRING TO MOVE
3$:	MOVB	(R3)+,(R4)+	;COPY IN RETRIEVAL STRING
	SOB	R0,3$
4$:	MOV	R5,R3		;COPY REGION ADDRESS
	JMP	COMEND		;AND GO FINISH LIKE OTHER RETRIEVAL
;
; FOLLOWING CODE SYNCHRONIZES THE SENDING OF A DATA BLOCK TO THE
; DATA BASE MANAGING PROGRAM AND THE RECEIPT OF DATA BACK FROM IT.
;
SYNC:	CLEF$S	#EVFL		;CLEAR EVENT FLAG 1
	GTABAD	AST,R0		;AST ADDRESS -> R0
	SRDA$S	R0		;DECLARE IT
	ADD	#SRFDPB-AST,R0	;SEND BY REF DPB ADDRESS -> R0
	GTABAD	WDB,S.RRBA(R0)	;PUT ABS ADD OF WDB IN DPB
	DIR$	R0		;SEND DATA TO DBM TASK
	MOV	@#$DSW,R0		;CHECK DIRECTIVE STATUS
	BLT	2$		;IF NEG, BRANCH
	WTSE$S	#EVFL		;AND WAIT FOR THE EVENT FLAG
2$:	SRDA$S	#0		;UN-DECLARE RECEIVE AST
	RTS	PC		;WE'VE RECEIVED THE DATA
;
; NOW THE AST ROUTINE
;
AST:
	GTABAD	VRCDPB,R0	;RECEIVE DPB ADD -> R0
	GTABAD	RBUF+2,R.VDBA(R0) ;INIT RECEIVE BUFFER ADDRESS
	MOV	#1,R.VDBL(R0)	;LENGTH ONE WORD
	DIR$	R0		;RECEIVE THE DATA
	MOV	@#$DSW,R0		;RECORD STATUS OF RECEIVE
	SETF$S	#EVFL		;SET EVENT FLAG TO RESUME MAIN TASK
	ASTX$S			;AND EXIT FROM AST
;
; SETUP
; ROUTINE TO DO INITIAL SET-UP FOR ONCREG
; THIS ROUTINE SHOULD BE EXECUTED EACH TIME ANY OF ENTRY POINTS
; IN THIS LOADABLE ROUTINE IS CALLED. THE ROUTINE WILL DECIDE IF
; REGION AND OTHER INFO HAS BEEN ALREADY SET UP AND IF NOT, DO IT.
; IT ALSO WILL ADJUST ANY ABSOLUTE ADDRESS NUMBERS WHICH MAY HAVE
; CHANGED BECAUSE OF BASIC LOADING OTHER LOADABLE ROUTINES.
;
SETUP:
	TST	RDBFLG		;REGION DEFINED YET?
	BNE	1$		;IF SO, BRANCH
;
; FOLLOWING CODE GETS AND STORES TERMINAL NAME AND NUMBER
;
	SUB	#14,SP		;MAKE ROOM ON STACK
	MOV	SP,R2		;ADDRESS -> R2
	GLUN$S	#2,R2		;GET INFO FOR LUN 2 (TERMINAL)
	MOV	(SP)+,TNUM	;NAME
	MOV	(SP)+,TNUM+2	;NUMBER
	ADD	#10,SP		;CLEAN STACK
;
	JSR	PC,INIREG	;IF REGION NOT DEFINED, DEFINE IT
	GTABAD	SRFDPB,R2	;ADDRESS OF DPB -> R2
;
; FOLLOWING CODE INSERTED TO ENABLE DEBUGGING COPIES OF THE
; DATA BASE MANAGER TO EXIST IN ACCOUNTS [200,16] (PEGGY)
; AND [200,20] (BONNIE).  IF THE SIGN-ON ACCOUNT IS NOT
; [200,15] (RADIATION ONCOLOGY) OR [200,16] (PEGGY), BONNIE'S
; COPY OF THE DATA BASE MANAGER IS USED, I.E., [200,20] IS
; ASSUMED.
;
	CMPB	@#UICSTO,#15	;IS IT [200,15] ?
	BEQ	1$		; IF YES, DON'T CHANGE DBM NAME
	CMPB	@#UICSTO,#16	;IS IT [200,16] ?
	BEQ	5$		; IF YES, CHANGE DBM NAME TO DBP (PEGGY)
	MOV	(PC)+,R4	; ASSUME [200,20], PUT NEW NAME IN R4
	.RAD50	/DBB/		; [200,20] NAME SHOULD BE ONCDBB (BONNIE)
	BR	6$
5$:	MOV	(PC)+,R4	; [200,16], PUT NEW NAME IN R4
	.RAD50	/DBP/		;   NAME SHOULD BE ONCDBP (PEGGY)
6$:	MOV	R4,S.RRTN+2(R2)	;STORE AWAY NEW NAME
	MOV	R4,VRCDPB-SRFDPB+R.VDTN+2(R2)	; IN 2 PLACES
1$:	JSR	PC,MAPREG	;MAP INTO REGION
	GTABAD	SRFBUF,W.NSRB(R3) ;SET UP BUFFER ADDRESS IN WDB FOR SEND
	GTABAD	MCX,R2		;NOW RE-CALCULATE ADDRESS OF SYSRES
	ADD	MCXOFF,R2	;MAPPING WINDOW WITHIN MCX, IN CASE
	MOV	R2,MCXADD	;IT HAS MOVED SINCE LAST TIME.
	RTS	PC
;
; MEMORY MANAGEMENT SUBROUTINES FOR DATA BASE MANAGEMENT
;
;
; CREREG
; ROUTINE TO DYNAMICALLY CREATE A UNIQUE REGION
; ON ENTRY:
;	R3 HAS REGION DEFINITION BLOCK ADDRESS
;	RDB SIZE ALREADY FILLED IN
;
; ON EXIT:
;	'C' CLEAR = SUCCESS, RDB FILLED IN
;	'C' SET   = FAILURE, R4 HAS DIRECTIVE ERROR CODE
;
CREREG:
1$:
	BIS	#<RS.ATT!RS.RED!RS.WRT!RS.DEL!RS.MDL>,R.GSTS(R3) ;SET FLAGS
	BIC	#RS.CRR,R.GSTS(R3)	;MAKE SURE WE SAY NO REGION CREATED YET
	CRRG$S	R3			;ATTEMPT TO CREATE AND ATTACH TO REGION
	BCS	5$			;ON ERROR, BRANCH
	MOV	RDB+R.GID,WDB+W.NRID	;MOVE REGION ID INTO WINDOW BLOCK
	BIT	#RS.CRR,R.GSTS(R3)	;DID WE ACTUALLY CREATE REGION?
	BNE	2$			;IF SO, SUCCESS: BRANCH
	JSR	PC,MAPREG	;MAP INTO REGION WE FOUND
	CMPB	$R.TI+2(R5),TNUM+2 ;COMPARE NUMBER
	BEQ	4$		;IF SAME, BRANCH
	JSR	PC,REMAP	;AND MAP BACK TO SYSRES
	GTABAD	RDB,R3		;PUT RDB ADDRESS BACK -> R3
	DTRG$S	R3			;IF NOT, WE GOT SOMEBODY ELSE'S REGION
					;SO DETACH IT
	INC	R.GNAM+2(R3)		;INCREMENT RAD50 NAME
	BR	1$			;AND TRY AGAIN
2$:	MOV	R.GNAM(R3),SRFBUF+$B.RNA ;SAVE REGION NAME
	MOV	R.GNAM+2(R3),SRFBUF+$B.RNA+2
	JSR	PC,MAPREG	;MAP INTO CREATED REGION
	MOV	TNUM,$R.TI(R5)	;STORE TERMINAL NAME
	MOV	TNUM+2,$R.TI+2(R5) ;AND NUMBER
4$:	JSR	PC,REMAP	;MAP BACK TO SYSRES FOR NOW
	CLC				;INDICATE SUCCESS
5$:	RTS	PC			;AND RETURN
;
; INIREG
; ROUTINE TO GET MAPPING CONTEXT AND CREATE REGION
; ON ENTRY:
;
; ON EXIT:

;	RDBFLG SET TO 1
;	MCX	FILLED WITH MAPPING CONTEXT FOR BASIC
;	RDB ADDRESS IN R3
;	'C' CLEAR ON SUCCESS
;	'C' SET ON FAILURE, R4 HAS DSW ERROR CODE
;
INIREG:
	GTABAD	MCX,R3		;CURRENT CONTEXT BUFFER ADDRESS -> R3
	GMCX$S	R3		;GET CURRENT CONTEXT
3$:
	TST	20(R3)		;CHECK NEXT WINDOW
	BMI	2$		;IF MINUS, THIS IS LAST WINDOW IN CONTEXT
	ADD	#20,R3		;ELSE GO AROUND AGAIN
	ADD	#20,MCXOFF	;BUT KEEP TRACK OF OFFSET
	BR	3$
2$:
	MOV	W.NID(R3),WDB+W.NID ;WE'LL USE SYSRES WINDOW
	MOV	W.NBAS(R3),WDB+W.NBAS ;AND ALSO SAME BASE ADDRESS
	GTABAD	RDB,R3		;RDB ADDRESS -> R3
	JSR	PC,CREREG	;CREATE UNIQUE REGION
	BCS	1$		;ON ERROR, BRANCH
	MOV	#1,RDBFLG	;INDICATE WE NOW HAVE A REGION
1$:	RTS	PC		;AND RETURN
;
; MAPREG
; ROUTINE TO MAP TO A REGION CREATED PREVIOUSLY
; ON ENTRY:
;	RDB HAS CREATED REGION
;	WDB HAS APR, WINDOW SIZE, FLAGS SET
;
; ON EXIT:
;	R3 HAS ADDRESS OF WDB
;	R5 HAS ADDRESS OF REGION (160000)
;	'C' CLEAR IF SUCCESS
;	'C' SET IF FAILURE: R4 HAS DSW
;
MAPREG:
	GTABAD	WDB,R3		;ADDRESS OF WINDOW FOR REGION -> R3
	MAP$S	R3		;MAP THE ADDRESS WINDOW
	BCC	1$		;IF OK, BRANCH
	MOV	@#$DSW,R4	;DIRECTIVE STATUS -> R4
1$:	MOV	W.NBAS(R3),R5	;BASE ADDRESS -> R5
	RTS	PC
;
; REMAP
; ROUTINE TO RESTORE SYSRES MAPPING ON APR 7
;
; ON ENTRY:
;	MCX BUFFER FILLED IN WITH GET MAPPING CONTEXT INFO
;		FROM ORIGINAL BASIC CONFIG
;	MCXADD HAS ADDRESS OF LAST (SYSRES) WINDOW IN MCX
; ON EXIT:
;	SYSRES MAPPED WITH APR7
;	MCX BUFFER UNCHANGED
; REGISTERS USED: R2
;
REMAP:
	MOV	MCXADD,R2	;ADDRESS OF WINDOW DEFINITION BLOCK -> R2
	MAP$S	R2		;MAP BACK TO SYSRES
	RTS	PC		;AND RETURN
END:
	.END