; VALIO - VAL PACKAGE I/O ROUTINES
; LAST EDIT:	1-OCT-81
;
;-
.NLIST
.NLIST	BEX
.LIST	TTM
.TITLE	VALIO
.LIST
;
.IDENT	/V003/
;
; THIS MODULE MUST BE ASSEMBLED PRECEDED BY THE FILE VALMFD
;
;+
;
; THIS MODULE CONTAINS BASIC TERMINAL PROMPTING AND INPUT
; ROUTINES FOR THE VAL PACKAGE. THEY MAY BE CALLED DIRECTLY
; FROM FORTRAN OR VIA THE VAL INPUT PARSING ROUTINES.
; THERE ARE:
;	VPRMPT - SPECIFY VARIABLE NAME AND PROMPT
;	VINPUT - OBTAIN A NEW LINE OF INPUT
;	VALERR - TO NOTIFY THE COMMAND LANGUAGE SYSTEM OF AN
;		 ERROR SITUATION.
;	VALQIO - TO QUEUE VAL INPUT BUT NOT WAIT.
;	VALTST - TO DETERMINE IF VAL INPUT IS AVAILABLE
;
; START MUST HAVE BEEN CALLED PRIOR TO ANY OF THESE CALLS.
;
;
; FOR MACRO CALLERS:-
; ONLY R5 IS PRESERVED THROUGH THESE CALLS.
;
; 
;-
;
.PSECT	VALIO
;
.MCALL	QIO$S,STSE$S,CLEF$S
;
RDOFF$	;DEFINE READIT OFFSETS
;
; FORTRAN PARAMETER BLOCK OFFSETS
P1=2
P2=4
P3=6
P4=10
P5=12
P6=14
P7=16
;
; CHARACTER CONSTANTS
SPACE=40
CR=15
LF=12
CTRLZ=32
ESCAPE=33
; 
;
;
;+
; VPRMPT - SET NAME AND PROMPT STRINGS
;
;	CALL VPRMPT(NAME,PROMPT)
; WHERE:	NAME -	ZERO TERMINATED STRING 0<L<=6.
;			THE NAME IS USED TO ACCESS THE
;			CLONE SYMBOL TABLE DIRECTLY.
;		PROMPT -ZERO TERMINATED PROMPT STRING 0<=L<=80.
;			THE PROMPT IS PRINTED BEFORE AN INPUT
;			REQUEST WITH NO TERMINATING CONTROL
;			CHARACTERS.
;
; NAME AND PROMPT STRINGS ARE SAVED IN THE IMPURE AREA.
; THE NAME AND PROMPT BUFFERS ARE NOT CLEARED WHEN AN
; INPUT REQUEST COMPLETES THUS SEVERAL REQUESTS MAY BE
; ISSUED WITH THE SAME PROMPT. A CALL WITH NULL OR ZERO
; PARAMETERS WILL RESET THE STORED STRINGS TO THEIR
; DEFAULT VALUES OF:	NAME=NULL, PROMPT='? '
;
;-
;
VPRMPT::CALL	VMAP		;GET IMPURE AREA
	MOVB	(R5),R4		;GET # OF ARGUMENTS
	MOV	VI.COM(R0),R1	;NAME STRING ADDRESS
	ADD	#VC.NAM,R1
	TST	R4		;ANY ARGS ?
	BEQ	1$
	CMP	P1(R5),#-1	;NAME NULL ?
	BEQ	1$
	MOV	P1(R5),R2	;STRING ADDRESS
	MOV	#7,R3		;MAXIMUM LENGTH
	CALL	SCOPY		;COPY STRING TO IMPURE AREA
	BR	2$
1$:	CLR	(R1)		;LOAD NULL STRING
2$:	MOV	VI.COM(R0),R1	;NOW THE PROMPT
	ADD	#VC.PRM,R1
	DEC	R4		;ONE LESS ARGUMENT
	BLE	3$
	CMP	P2(R5),#-1	;PROMPT SUPPLIED ?
	BEQ	3$
	MOV	P2(R5),R2	;ADDRESS OF PROMPT STRING
	MOV	#81.,R3		;MAX LENGTH
	CALL	SCOPY
	BR	4$
3$:	MOVB	#'?,(R1)+
	MOVB	#' ,(R1)+
	CLRB	(R1)
4$:	MOV	VI.COM(R0),R1	;RESTORE R1
	CALL	VRSCTX		;RESTORE USER CONTEXT
	RETURN
;
;
;
; SCOPY COPIES A STRING ON R2 TO A BUFFER ON R1
; MAX STRING LENGTH IS IN R3. ZERO BYTE TERMINATES BOTH
; INPUT AND OUTPUT STRINGS.
;
SCOPY:	DEC	R3
	BEQ	1$
	MOVB	(R2)+,(R1)+
	BEQ	2$
	BR	SCOPY
1$:	CLRB	(R1)
2$:	RETURN	
;
;
;+
;
; VINPUT - INPUT A LINE OF TEXT
;
;	CALL VINPUT(BUF,MAXLEN,LEN)
; WHERE:	BUF -	BUFFER TO RECEIVE TEXT
;		MAXLEN-	LENGTH OF BUF
;		LEN -	VARIABLE TO RECEIVE ACTUAL LINE LENGTH
;
; ARGUMENTS MUST BE ALL PRESENT OR ALL ABSENT
; THE LINE IS READ TO THE BUFFER IN VALCOM, THEN IF BUF
; IS SUPPLIED, COPIED TO BUF. THE BUFFER IS ALWAYS ZERO
; TERMINATED.
;
; IF NO USER BUFFER IS SUPPLIED AS IN A CALL FROM MACRO, THEN 
; THE LINE READ IS AVAILABLE AT VC.LBF+1 IN VALCOM WITH A LENGTH
; BYTE AT VC.LBF.  RD.KP IN VALIMP IS AJUSTED TO POINT TO THE 
; BEGINNING OF THE BUFFER WHICH WILL BE A NULL BYTE AFTER A
; COPY TO A USER BUFFER.
;
;
; NOTE THAT INPUT LINES STARTING WITH '@' WILL BE PASSED
; TO THE CLONE COMMAND LANGUAGE PROCESSOR. AS WILL A LINE
; TERMINATED BY 'ESCAPE'.
;
;-
;
VINPUT::MOV	R5,-(SP)
	CALL	VMAP		;GET VALIMP, VALCOM ADDRESSES
	BIC	#ST.NWT,VC.STA(R1);CLEAR NO WAIT FLAG
	MOV	R1,RD.KP(R0)	;RESET CHARACTER POINTER
	ADD	#VC.LBF+1,RD.KP(R0)
1$:	BIT	#ST.CL1,VC.STA(R1);ARE WE UNDER CLONE
	BEQ	2$		;IF NOT SKIP
	CALL	CL1Q$		;ISSUE REQUEST TO CLONE
	BCS	1$		;REPEAT IF REQUEST REJECTED
	BR	10$		;RETURN RESULT
2$:	CALL	VALQ		;ELSE JUST PROMPT AND READ
	MOV	R1,R2		;GET BUFFER POINTER
	ADD	#VC.LBF+1,R2
	CMPB	(R2),#'@	;CLONE COMMAND ?
	BEQ	4$		;IF SO GO CONNECT
	MOVB	VC.LBF(R1),R3	;POINT TO END OF BUFFER
	ADD	#VC.LBF,R3
	ADD	R1,R3
	CMPB	(R3),#ESCAPE	;CHECK FOR ESCAPE
	BNE	10$		;NOT A CLONE REQUEST
	CLRB	(R3)		;PATCH OUT THE ESCAPE
	DEC	VC.LBF(R1)	;AND DONT COUNT IT
4$:	CALL	CL1C$		;CALL CL1 CONNECT
	BR	1$		;NOW DO THE REAL INPUT
;
10$:	MOV	(SP)+,R5	;GET BACK ARGUMENT LIST
	TSTB	(R5)		;ANY ARGS ?
	BEQ	12$
	MOV	R1,R2		;POINT TO VALCOM BUFFER
	ADD	#VC.LBF+1,R2
	MOV	P1(R5),R1	;GET CALLER BUFFER
	MOV	@P2(R5),R3	;GET BUFFER LENGTH
	CALL	SCOPY		;COPY STRING TO USER BUFFER
	MOV	VI.COM(R0),R1	;RESTORE VALCOM POINTER
	MOVB	VC.LBF(R1),R2	;GET STRING LENGTH
	MOV	R2,@P3(R5)	;AND RETURN IT
	CLRB	VC.LBF+1(R1)	;NULL BUFFER
12$:	CALL	VRSCTX		;RESTORE CALLER CONTEXT
	RETURN
;
;
;+
;
; VALQ - PERFORM A TERMINAL INPUT REQUEST USING THE PROMPT
; LOCATED AT VC.PRM AND RETUTNING A BUFFER OF <=80 CHARS
; AT VC.LBF+1. VC.LBF RECIEVES THE NUMBER OF CHARS IN THE BUFFER
; WHICH IS ALSO ZERO BYTE TERMINATED.
; THE PROMPT IS ISSUED BY OUTS THE CALL BLOCK BEING
; CREATED IN THE SCRATCH AREA OF VALIMP
;
.GLOBL	OUTS
;
VALQ:	BIT	#ST.QIO,VC.STA(R1);IS INPUT ALREADY QUEUED ?
	BNE	VIN		;IF SO DONT PRINT PROMPT
	TSTB	VC.PRM(R1)	;IS PROMPT NULL ?
	BEQ	VIN		;IF SO DONT PRINT
	MOV	R0,R5		;SET UP OUTS BLOCK
	ADD	#VI.SCR,R5
	MOV	#3,(R5)		;THREE ARGS:STR,LIN,DEV
	MOV	R1,P1(R5)	;PROMPT STRING ADDRESS
	ADD	#VC.PRM,P1(R5)
	MOV	#PMODE,P2(R5)	;SELECT PROMPT MODE
	MOV	#OUTTI,P3(R5)	;OUTPUT TO TI: DEVICE #
	CALL	OUTS		;AND ISSUE PROMPT
;
VIN:	CALL	VQIO		;START INPUT REQUEST
	BIT	#ST.NWT,VC.STA(R1);DO WE WAIT
	BNE	10$		;SKIP IF NOT
	MOV	VI.LUN(R0),R2
	BNE	1$
	MOV	VI.DLN(R0),R2
1$:	TSTB	VC.QST(R1)	;ANY STATUS RETURN
	BNE	2$		;SKIP IF SOMETHING THERE
	STSE$S	R2		;ELSE STOP FOR EVENT FLAG
	CLEF$S	R2		;RESET IT
	BR	1$		;AND CHECK WE GOT SOMETHING
;
2$:	BIC	#ST.QIO!ST.NWT,VC.STA(R1);QIO COMPLETE
	MOV	R1,R4
	ADD	#VC.LBF+1,R4	;GET BUFFER POINTER
	MOVB	VC.QST+2(R1),R2	;GET BUFFER LENGTH
	MOVB	R2,VC.LBF(R1)	;AND STORE IT
	BEQ	5$		;SKIP IF NOTHING THERE
3$:	TSTB	(R4)+		;SUPPRESS ANY NULLS
	BNE	4$
	MOVB	#2,-1(R4)	;CTRL-B IS IGNORED BY READIT
4$:	SOB	R2,3$		;KEEP LOOPING
5$:	CMPB	VC.QST(R1),#IE.EOF;CTRL Z ?
	BNE	6$
	MOVB	#CTRLZ,(R4)+	;PATCH IN A CONTROL-Z
	BR	7$
6$:	CMP	VC.QST(R1),#IS.ESC	;TERMINATED BY ESCAPE ?
	BNE	8$
	MOVB	#ESCAPE,(R4)+		;IF SO PUT IN BUFFER
7$:	INCB	VC.LBF(R1)		;COUNT EXTRA CHAR.
8$:	CLRB	(R4)		;ZERO END OF BUFFER
10$:	RETURN			;AND BACK TO INPUT
;
; ACTUALY ISSUE THE QIO
VQIO:	BIT	#ST.QIO,VC.STA(R1)
	BNE	10$		;QUIT IF ALREADY IN PROGRESS
	MOV	R1,R3
	ADD	#VC.QST,R3	;ADDRESS OF STATUS BLOCK
	MOV	VI.LUN(R0),R2	;IS EXPLICIT LUN SET ?
	BNE	1$		;IF SO USE IT
	MOV	VI.DLN(R0),R2	;ELSE GET DEFAULT
1$:	MOV	R1,R4		;ADDRESS OF BUFFER
	ADD	#VC.LBF+1,R4
	BIS	#ST.QIO,VC.STA(R1);SET STATUS BIT
	QIO$S	#IO.RVB,R2,R2,,R3,,<R4,#80.>
10$:	RETURN
;
PMODE:	.WORD	2		;PROMPT MODE CODE FOR OUTS
OUTTI:	.WORD	0		;OUTPUT TO TI: AT ORSAY
;
;
;+
;
; VALERR - FLAG VAL ERROR CONDITION
;
; THIS ROUTINE PERMITS THE USER TO SPECIFY THAT SOME
; EXEPTIONAL ERROR CONDITION HAS TAKEN PLACE .
; FURTHER INPUT TAKES PLACE IN SPECIAL-MODE.
; SPECIAL-MODE IS NOT RELEVANT TO 'FREE' OPERATION OF
; THE PACKAGE, BUT UNDER A COMMAND LANGUAGE PROCESSOR
; THIS MODE PROTECTS AGAINST LOSS OF REQUEST SYNCRONISATION
; DURING ERRORS DETECTED BY THE PROGRAM. SPECIFICALY
; NO NAME LOOKUPS ARE PERFORMED OR REPLIES ACCEPTED
; AND QUESTIONS ARE FORCED DIRECTLY TO THE CONSOLE
;
;	CALL VALERR([N])
;WHERE:	N IS THE FUNCTION FLAG
;	IF N=0 OR ABSENT:
;		THE INPUT BUFFER IS CLEARED AND THE NEXT
;		REQUEST TAKES PLACE IN SPECIAL MODE.
;	IF N>0 :
;		THE INPUT BUFFER IS CLEARED AND VAL ENTERS
;		SPECIAL MODE CONTINUOUSLY
;	IF N<0 :
;		SPECIAL MODE IF ACTIVE IS CLEARED.
;
;-
;
VALERR::CALL	VMAP
	TSTB	(R5)		;IS THERE AN ARG ?
	BEQ	1$		;GO DO SINGLE SHOT
	TST	@P1(R5)
	BEQ	1$
	BLT	2$		;DISABLE SPECIAL MODE
	BIS	#ST.SPC,VC.STA(R1);ENABLE SPECIAL MODE
1$:	BIS	#ST.ERR,VC.STA(R1)
	CLRB	RD.IST(R0)	;CLEAR READIT STATUS BYTE
	MOVB	#1,RD.ITW(R0)	;SET END OF LINE
	MOV	R1,RD.KP(R0)	;LEAVE POINTER ON A ZERO BYTE
	ADD	#VC.LBF+1,RD.KP(R0)
	CLRB	@RD.KP(R0)	
	BR	3$
2$:	BIC	#ST.ERR!ST.SPC,VC.STA(R1)
3$:	CALL	VRSCTX
	RETURN
;
;
;+
;
; VALTST - DETERMINE IF INPUT IS AVAILABLE
;
;	CALL VALTST(N)
;
; WHERE:	N RECEIVES THE NUMBER OF CHARS IN THE 
;		INPUT BUFFER. OR <0 IF BUFFER IS EMPTY
;		A REPLY OF CR HAS ZERO LENGTH.
;		IF THE BUFFER IS EMPTY:
;			N=-1 TERMINAL INPUT
;			N=-2 CLONE IS ACTIVE AND HAS DATA READY.
;
;-
;
VALTST::CALL	VMAP		;GET IMPURE AREA
	BIT	#ST.QIO,VC.STA(R1);INPUT QUEUED ?
	BNE	3$		;SKIP IF SO
	MOV	RD.KP(R0),R2	;GET POINTER
	CLR	@P1(R5)		;AND COUNT CHARS IN BUFFER
1$:	TSTB	(R2)+
	BEQ	2$
	INC	@P1(R5)
	BR	1$
2$:	TST	@P1(R5)		;ANYTHING THERE ?
	BGT	20$		;IF SO NO PROBS
	BR	10$		;GO RETURN -1
;
3$:	TSTB	VC.QST(R1)	;INPUT COMPLETED ?
	BEQ	10$		;NO RETURN NOTHING
	MOV	VC.QST+2(R1),@P1(R5)
	BR	20$
;
; HERE THE INPUT BUFFER IS EMPTY
10$:	MOV	#-1,@P1(R5)	;RETURN NOTHING THERE FLAG
	BIT	#ST.CL1,VC.STA(R1) ;ARE WE UNDER CLONE ?
	BEQ	20$		;IF NOT SKIP AND RETURN -1
	CALL	CL1T$		;ISSUE TEST TO CLONE
	BCS	20$		;IF CLONE HAS NOTHING RETURN -1
	DEC	@P1(R5)		;RETURN -2
20$:	CALL	VRSCTX		;RESTORE CALLER CONTEXT
	RETURN
;
;
;+
;
; VALQIO - QUEUE AN INPUT REQUEST AND RETURN IMMEDIATLY
;
;	CALL VALQIO(NAME,PROMPT,IEFN)
;
; ON RETURN IEFN CONTAINS AN EVENT FLAG ASSOCIATED
; WITH THE INPUT REQUEST. IF INPUT IS ALREADY IN PROGRES
; NO FURTHER ACTION IS TAKEN. IF DATA REMAINS IN THE BUFFER
; IT IS CLEARED TO AVOID UNPREDICTABLE BEHAVIOUR
; SUBSEQUENTLY VALTST MAY BE CALLED TO DETERMINE IF THE
; REQUEST HAS COMPLETED OR THE EVENT FLAG MAY BE READ
; DIRECTLY.
;
;
;-
;
VALQIO::MOV	R5,-(SP)
	CALL	VMAP		;GET IMPURE AREA
	BIT	#ST.QIO,VC.STA(R1)
	BNE	2$		;INPUT ALREADY QUEUED
	MOV	R1,R2		;PUSH POINTER TO VERY END OF BUFFER
	ADD	#VC.LBF+81.,R2
	CLRB	(R2)		;WITH ZERO BYTE
	MOV	R2,RD.KP(R0)
	CALL	VPRMPT		;PARSE NAME AND PROMPT
	CALL	VMAP
	BIS	#ST.NWT,VC.STA(R1);SET NO-WAIT FLAG
	BIT	#ST.CL1,VC.STA(R1);ARE WE UNDER CLONE
	BEQ	1$		;IF NOT ISSUE QIO
	CALL	CL1Q$		;AND START REQUEST
	BR	2$
1$:	CALL	VALQ		;ISSUE INPUT REQUEST
2$:	MOV	(SP)+,R5
	CMPB	(R5),#3		;EFN REQUIRED ?
	BLT	10$
	MOV	VI.LUN(R0),@P3(R5)
	BNE	10$
	MOV	VI.DLN(R0),@P3(R5)
10$:	CALL	VRSCTX
	RETURN
;
;
;+
;
; VALGSW - GET VALUE OF VAL STATUS WORD

; THIS ROUTINE IS CALLED GENERALY FROM MACRO TO OBTAIN IN R0
; THE VAL STATUS WORD FROM VC.STA IN VALCOM
; E.G.	CALL	VALGSW
;	BIT	#ST.###,R0
;
; R1 IS ALSO DESTROYED
;
;-
;
VALGSW::CALL	VMAP
	MOV	VC.STA(R1),R0
	CALL	VRSCTX
	RETURN
;
;
;+
; VALSSW - WRITE VAL STATUS WORD
; INPUT:	R0=NEW STATUS WORD VALUE
;
; R1 IS DESTROYED
;
; WARNING VALGSW SHOULD ALWAYS BE CALLED FIRST AND A
; BIS/BIC OPERATION PERFORMED ON THE SELECTED BIT(S)
; OTHERWISE OBSCURE PROBLEMS MAY RESULT.
;
VALSSW::MOV	R0,-(SP)
	CALL	VMAP
	MOV	(SP)+,VC.STA(R1)
	CALL	VRSCTX
	RETURN
;
	.END