.TITLE	NMCR
	.IDENT	/01.00/
 
;
; FORTRAN INTERFACE ROUTINES FO4 VIRTUAL TERMINAL DRIVER
;
; D. ELDERKIN 24-MAY-77
;
 
;
; MACRO CALLS
;
 
	.MCALL	ALUN$,DIR$,QIOW$
 
;
; LOCAL MACRO
;
 
	.MACRO TABLE	A,B,C,D
	.PSECT	CHAR
	.BYTE	A
	.PSECT	FIRST
	.BYTE	B
	.PSECT	SECOND
	.BYTE	C
	.PSECT	LAST
	.BYTE	D
	.PSECT
	.ENDM
 
;
; EQUATED SYMBOLS
;
 
LF=12			; LINE FEED
FF=14			; FORM FEED
CR=15			; CARRIAGE RETURN
 
ARG1=2			; OFFSETS OF SUBROUTINE ARGUMENTS ON THE STACK
ARG2=ARG1+2
ARG3=ARG2+2
ARG4=ARG3+2
; LOCAL STORAGE
;
ALUN:	ALUN$	0,VT,1		; ASSIGN UNIT TO VT1:
QIO:	QIOW$	IO.RVB,1,1,,IOSB,,<0,80.>;TEMPLATE DBP FOR QIO
IOSB:	.BLKW	2		; I/O STATUS BLOCK
MODE:	.BLKB			; INPUT OR OUTPUT
				; 0=WAITING FOR INFO FROM SYSTEM(IO.RVB DONE)
				; 1=PROVIDING INPUT FOR SYSTEM(IO.WVB DONE)
EOFFLG:	.BYTE	0		; STORED EOF?
ASSIGN:	.BYTE	0		; 0=NO, 1=YES
	.EVEN
STRBUF:	.BLKW			;STARTING ADDRESS OF BUFFER
;
; TABLE OF SYNTAX RULES FOR INTERPRETING CARRIAGE CONTROL CHARACTERS
; IN OUTPUT STRINGS
;
	.PSECT	CHAR
CHAR:
	.PSECT	FIRST
FIRST:
	.PSECT	SECOND
SECOND:
	.PSECT	LAST
LAST:
	.PSECT
 
	TABLE	60,LF,LF,CR	; DOUBLE SPACE
	TABLE	61,FF,0,CR	; PAGE EJECT
	TABLE	53,0,0,CR	; OVERPRINT
	TABLE	44,LF,0,0	; PROMPTING OUTPUT
	TABLE	0,0,0,0		; INTERNAL FORMAT CONTROL
	.PSECT	CHAR
ENDTBL=.-CHAR
	.PSECT
	TABLE	40,LF,0,CR	; SINGLE SPACE
 
MCRPRM:				; STRING THAT WE SEE WHEN THE MCR PROMPTS
	.BYTE	0,CR,LF,'>
MCRLNG=.-MCRPRM			; LENGTH OF THAT STRING
	.EVEN
 
;+
; THIS IS A SUBROUTINE WHICH A FORTRAN PROGRAM WILL CALL IN ORDER TO
; USE THE VIRTUAL TERMINAL DRIVER ON THE SYSTEM.  INPUT FROM THE PROGRAM
; MAY BE EITHER SOLICITED OR UNSOLICITED.
;
;  CALL FORMAT:
;
;	CALL NMCR(IBUF,IEOF,INP,ILUN)
;
;		IBUF - A 42.WORD INTEGER ARRAY WHICH CONTAINS A STRING
;			FOR INPUT TO THE SYSTEM )INP=1) OR IS A BUFFER
;			TO RECEIVE A STRING FROM THE SYSTEM (INP=0).
;		IEOF - A ONE WORD INTEGER,
;			=1, THE LAST LINE OF OUTPUT HAS BEEN RECEIVED
;				FROM THE SYSTEM (INP=0).
;			=0, THERE MAY BE MORE LINEW OF OUTPUT COMING
;				AND NMCR SHOULD BE CALLED AGAIN WITH
;				INP=0
;			=-1, A SYSTEM ERROR OCCURED DURING PROCESSING
;				THE USER PROGRAM SHOULD EXIT.
;		INP - A ONE WORD INTEGER
;			=1, IBUF CONTAINS A STRING TO BE SUBMITTED TO
;				THE SYSTEM AS INPUT.
;			=0, IBUF IS A BUFFER TO BE USED TO RECEIVE OUTPUT
;				FROM THE SYSTEM.
;		ILUN - A ONE WORD INTEGER WHICH IS THE LOGICAL UNIT TO
;			BE USED TO COMMUNNICATE WITH THE VIRTUAL TERMINAL.
;
; WHEN THIS ROUTINE IS ENTERED
;
;	R5 ->	NUMBER OF ARGUMENT(4)
;		ADDRESS OF IBUF
;		ADDRESS OF IEOF
;		ADDRESS OF INP
;		ADDRESS OF ILUN
;-
NMCR::
	TSTB	EOFFLG		; HAVE WE STORED UP EOF?
	BNE	EOFOUT		; IF NE YES, TELL THE USER
	TSTB	ASSIGN		; HAVE WE ALREADY ASIGNED THE UNIT?
	BNE	1$		; IF NE YES, DON'T DO IT AGAIN
	MOV	@ARG4(R5),ALUN+A.LULU ; STORE THE SPECIFIED LUN NUMBER
	BEQ	ERROR		; IF EQ ILLEGAL LUN SPECIFIED, ERROR
	MOV	@ARG4(R5),QIO+Q.IOLU ; STORE THE LUN
	DIR$	#ALUN		; ASSIGN THE LUN
	BCS	ERROR		; IF CS SOME ERROR DURING ASSING
	MOVB	#1,ASSIGN	; NOTE THAT THE ASSIGN HAS BEEN DONE
1$:
	MOV	ARG1(R5),R0	; FETCH THE BUFFER ADDRESS FROM THE ARG LIST
	MOVB	@ARG3(R5),MODE	; SAVE THE MODE
				; 0=WAIT FOR RESPONSE FROM THE SYSTEM(IO.RVB DONE)
				;1=PROVIDE INPUT FOR THE SYSTEM(IO.WVB DONE)
	BEQ	15$		; IF EQ INPUT
	MOV	#IO.WVB,QIO+Q.IOFN ; SET THE FUNCTION TO WRITE
	MOV	R0,R1		; COPY THE BUFFER ADDRESS
	CLR	R2		; INIT THE CHARACTER COUNT
5$:
	CMPB	#CR,(R1)+	; FOUND THE FINAL CHARACTER YET?
	BEQ	10$		; IF EQ YES
	INC	R2		; COUNT THE CHARACTER
	BR	5$		; AND CONTINUE SEARCHING
10$:
	MOV	R2,QIO+Q.IOPL+2 ; SAVE THE CHARACTER COUNT
	BNE	20$		; IF NE NO PROBLEMS
	INC	QIO+Q.IOPL+2	; DON'T ALLOW JUST ONE CR TO MAKE A BUFFER
	BR	20$		; NOW CONTINUE
15$:
	MOV	#IO.RVB,QIO+Q.IOFN ; SET THE FUNCTION TO READ
	INC	R0		; SKEW THE BUFFER POSITIN TO ALLOW ROOM
				; FOR A LEADING CARRIAGE CONTROL CHARACTER
	MOV	#80.,QIO+Q.IOPL+2 ; AND READ AS MANY CHARS AS POSSIBLE
20$:
	MOV	R0,QIO+Q.IOPL	; SAVE THE BUFFER POSITION
	MOV	R0,STRBUF	;
	DIR$	#QIO		; DO THE IO TO THE VT
	BCS	ERROR		; IF CS ERROR ON THE OPERATION
	MOVB	IOSB,R0		; FETCH THE FIRST WORD OF THE  I/O STATUS BLOCK
	BPL	30$		; ALL CLEAR
	CMPB	#IE.EOF&377,R0	; WAS IT AN EOF?
	BNE	ERROR		; IF NE, PROBLEMS
				;
				; EOF RECEIVED FROM SYSTEM, INFORM USER
				;
	BR	EOFOUT		; DO IT
30$:
	CLR	@ARG2(R5)	; NOTE THAT NO EOF WAS PRESENT
	TSTB	MODE		; WAS THAT INPUT OR OUTPUT
	BNE	DONE		; IF NE DONE, RETURN TO THE USER
				;
				; CHECK FOR MCR PROMPT
				;
	MOV	STRBUF,R0	; POINT TO SATRT OF OUTPUT BUFFER
	MOV	R0,R5		; COPY STARTING ADDRESS
	CLRB	-1(R0)		; PUT A NULL IN THE FIRST OUTPUT BYTE
	ADD	#80.,R5		; POINT R5 TO END OF BUFFER
	MOV	#MCRLNG,R1	; SET LENGTH OF THE PROMPT
	CMP	R1,IOSB+2	; SEE IF LENGTH IS CORRECT
	BNE	37$		; IF NE ->NOT CORRECT, NOT MCR PROMPT
	MOV	#MCRPRM,R2	; SET STARTING ADDRESS OF PROMPT
32$:
	CMPB	(R0)+,(R2)+	; SEE IF THE NEXT CHARACTER MATCHES
	BNE	35$		; IF NE NOT CORRECT, NOT MCR PROMPT
	DEC	R1		; CONTINUE FOR ENTIRE PROMTP
	BNE	32$		; IF NE NOT DONE CHECKING
	INCB	EOFFLG		; SAVE UP AN EOF FOR THE NEXT READ
	MOV	R0,R4		; COPY FINAL POSITION IN BUFFER
	BR	60$		; NOW CLEAR OUT REMAINDER OF BUFFER
				;
				; INTERPRET OUTPUT CARRIAGE CONTROL
35$:
	MOV	STRBUF,R0	; FETCH ADDRESS OF START OF BUFFER
37$:	
	MOV	R0,R4		; AND AGAIN
	ADD	IOSB+2,R4	; COMPUTE WHERE LAST CHARACTER OF USED BUFFER IS
	MOVB	(R0),R1		; FETCH CHARRIAGE CONTROL BYTE FROM BUFFER
	DEC	R0		; POINT TO BEGINNING OF BUFFER
	CLR	R2		; INITIALIZE POINTER INTO TABLE OF CARRIAGE
				; CONTROL SYNTAX RULES
40$:
	CMPB	CHAR(R2),R1	; IS THIS THE CARRIAGE CONTROL CHARACTER
	BEQ	50$		; IF EQ YES, DO CARRIAGE CONTROL
	INC 	R2		; POINT TO THE NEXT SYSNTAX RUNE
	CMP	R2,#ENDTBL	; END OF TABLE REACHED?
	BNE	40$		; IF NE NO, CONTINUE
50$:
	MOVB	FIRST(R2),(R0)+	; INSERT FIRST CARRIAGE CONTROL CHARACTER
	MOVB	SECOND(R2),(R0)+ ; INSERT SECOND
	MOVB	LAST(R2),(R4)+	; INSERT LAST AT END OF BUFFER
60$:
	CLRB	(R4)+		; FILL THE REST OF THE BUFFER WITH NULLS
	CMP	R4,R5		; AT THE END OF BUFFER YET?
	BLOS	60$		; IF LOS NO, CONTINUE LOOPING
	RETURN
EOFOUT:				; EOF SEEN , TELL THE USER
	CLRB	EOFFLG		; CLEAR THE EOF SAVED INDICATOR
	MOV	#1,@ARG2(R5)	; SET THE SECOND ARGUMENT TO 1
	RETURN
ERROR:
	MOV	#-1,@ARG2(R5)	; NOTE THAT A SERIOUS ERROR OCCURED
DONE:				; REF LABEL
	RETURN			; AND RETURN TO FORTRAN
	.END