.TITLE GETCMD
	.IDENT	/V1.2/
;
;	*** GETCMD ***  SUBROUTINES TO PROVIDE FORTRAN ACCESS TO THE
;	SYSTEM COMMAND-LINE PROCESSING ROUTINES
;
;+
;	CALL INICMD ( [ILUN] [,IEXT] [,PROMPT] )
;
; INITIALIZE PARAMETERS FOR GETCMD ROUTINES
;WHERE:
;	ILUN	- LOGICAL UNIT NUMBER FOR COMMAND I/O  (DEFAULT = 4)
;		  ** THIS LUN MUST BE ASSIGNED TO TI: BEFORE GETCMD IS CALLED)
;	IEXT	- RAD-50 DEFAULT INDIRECT COMMAND FILE EXTENSION
;		  (DEFAULT = 'CMD')
;	PROMPT	- ASCII PROMPT STRING (MUST BE AT LEAST 3 CHARS)
;		  (DEFAULT = TASK NAME, PRINTING AS  'xxx>')
;		  (1ST OR 2ND HALF OF TASK NAME (NOT '...'))
;
;*** NOTE THAT THE (PROMPT) PARAMETER SPECIFIES A DEFAULT PROMPT, WHICH CAN
;    BE OVERRIDDEN BY A PROMPT SPECIFIED IN THE CALL TO GETCMD
;
;-
	.MCALL	FDOF$L,GCMLB$,GCML$,RCML$,CCML$,GTSK$S
	FDOF$L		;DEFINE FILE CONTROL BLOCK OFFSETS

GCLBLK:	GCMLB$	3,,0,4,,0		;DEFINE GETCMD CONTROL BLOCK
TSKBUF:	.BLKW	16.			;  MAXIMUM NESTING DEPTH = 3
					;  LOGICAL UNIT NUMBER = 4
					;  (MUST BE ASSIGNED TO TI: BY TKB)
	.EVEN
	MFSUBR	INICMD		;DEFINE ENTRY POINT AND LINK
	MFARG	3		;DECODE ARGS (3 ALLOWED)
	POP	R4		;GET LUN
	BEQ	10$		; NONE
	MOV	(R4),GCLBLK+F.LUN	;SET LUN
10$:	POP	R4		;GET DEFAULT EXTENSION
	BEQ	15$
	MOV	GCLBLK+F.DFNB,R5	;GET PTR TO DEFAULT FILENAME BLOCK
	MOV	(R4),N.FTYP(R5)	;INSERT NEW DEFAULT
15$:	POP	R4		;GET PROMPT STRING ADDRESS
	BNE	30$		;GOT ONE
	MOV	#TSKBUF,R0	;POINT TO BUFFER TO RECEIVE EXEC INFO
	GTSK$S	R0		;GET TASK NAME
	MOV	(R0)+,R1	;GET 1ST HALF
	CMP	R1,#^R...	; DOTS?
	BNE	20$		;  NOPE...USE IT
	MOV	(R0),R1		;  YES....USE 2ND HALF
20$:	MOV	R0,R4		;POINT TO ASCII STRING (NOT THERE YET)
	CALL	$C5TA		;PUT IT THERE
30$:	MOV	#GCLBLK+G.DPRM+2,R5	;GET ADDRESS OF PROMPT AFTER <CR><LF>
	MOVB	(R4)+,(R5)+	;MOVE IN NEW DEFAULT PROMPT
	MOVB	(R4)+,(R5)+
	MOVB	(R4)+,(R5)+
50$:	RETURN


;+
;	CALL  FLGCMD ( [MODSET] [,MODCLR] [,RCTL] )
;
;	SET/CLEAR FLAG BITS -- SENSE INPUT FILE CHARACTERISTICS
;WHERE:
;	MODSET	- L*1 BITS TO SET IN THE BYTE AT G.MODE
;	MODCLR	- L*1 BITS TO CLR IN THE BYTE AT G.MODE
;	RCTL	- L*1 RETURNS DEVICE CHAR BYTE OF INPUT DEVICE (F.RCTL)
;
;-
	MFSUBR	FLGCMD		;DEFINE LINK
	MFARG	3,,<1,2>,<0,0>	;GET ARGS (1ST TWO DEFAULT TO ZERO)
	MOV	#GCLBLK+G.MODE,R0	;GET ADDRESS OF MODE BYTE
	BISB	@(SP)+,(R0)	;SET BITS OF 1ST ARG
	BICB	@(SP)+,(R0)	;CLR BITS OF 2ND ARG
RCTRET:	POP	R0		;GET RCTL ARG
	BEQ	10$		; NONE, SO SKIP RETURN VALUE
	MOVB	GCLBLK+F.RCTL,(R0)	;MOVE IN CHARACTERISTICS BYTE
10$:
$.$MCR::	RETURN	;DEFINE ENTRY POINT FOR OTS CLEAR MCR

;+
;
;	GETCMD -- SUBROUTINE TO PROVIDE FORTRAN ACCESS TO THE SYSTEM
;	COMMAND-LINE PROCESSING ROUTINES
;
; CALL GETCMD (IBUF,[IBSIZ][,LENGTH][,PROMPT][,PLENGTH][,IERR][,FERR][,RCTL])
;
;WHERE:
;		IBUF	- INPUT BUFFER (IF IBSIZ DEFAULTED, 80. BYTES)
;		IBSIZ	- LENGTH OF IBUF (IN BYTES) IF NOT 80.
;			  *** NOTE THAT THE LARGEST RECORD THAT MAY BE READ
;			      IS (IBSIZ - 2) BYTES LONG
;		LENGTH	- LENGTH OF RETURNED COMMAND-LINE
;			  *** THE COMMAND LINE WILL BE PADDED WITH NULLS
;		PROMPT - OPTIONAL USER PROMPT (MUST INCLUDE CARRIAGE CONTROL)
;			  (IF OMITTED, DEFAULT PROMPT IS USED)
;		PLENGTH - LENGTH (IN BYTES) OF USER PROMPT
;			  (IF ZERO OR BLANK, PROMPT MUST BE TERMINATED
;			   WITH A NULL (ZERO))
;		IERR	- LOGICAL*1 ERROR RETURN CODE (0 - NO ERRORS)
;		FERR	- L*1 FCS ERROR RETURN CODE (VALID IF IERR = -1 OR -2)
;		RCTL	- L*1 RETURNS DEVICE CHAR BYTE OF INPUT DEVICE (F.RCTL)
;-
	MFSUBR	GETCMD		;ENTRY AND LINK
	MFARG	8.,<1>,<2>,<80.>	;DECODE ARGS
	POP	GCLBLK+G.DPRM-2		;SET BUFFER ADDRESS
	POPARG	R5			;GET SIZE OF BUFFER
	SUB	#2,R5			;KNOCK OFF SCRATCH WORD FOR GCML
	MOV	R5,GCLBLK+G.SIZE	;SET SIZE
	POP	R4		;SAVE ADDRESS OF RETURNED SIZE
	CLR	R2		;CLEAR SIZE OF PROMPT
	POP	R1		;GET ADDRESS OF PROMPT STRING
	BEQ	10$		; NONE
	POP	R2		;GET SIZE
	BEQ	5$		; NONE, COMPUTE IT
	MOV	(R2),R2		;GET BYTE COUNT OF PROMPT STRING
	BR	25$		; AND DO IT
;
5$:	MOV	R1,R3		;COPY PROMPT STRING ADDR
6$:	TSTB	(R3)+		;LOOK FOR NULL TERMINATOR
	BEQ	25$		; GOT IT....R2 HAS BYTE COUNT
	INC	R2		;COUNT CHARS
	BR	6$
;
10$:	POP			;SKIP PROMPT SIZE IF NO PROMPT
25$:	GCML$	#GCLBLK,R1,R2	;GET A COMMAND LINE
	MOV	G.CMLD(R0),R1	;GET BYTE COUNT
	MOV	G.CMLD+2(R0),R2	;GET BUFFER ADDRESS
	MOV	GCLBLK+G.DPRM-2,R0	;GET DEST BUFFER
	MOV	R1,R3		;COPY SIZE
	BEQ	35$		; ZERO...SKIP TRANSFER
30$:	MOVB	(R2)+,(R0)+	;SHUFFLE THE STRING
	SOB	R3,30$
35$:	SUB	R1,R5		;COMPUTE NUMBER OF BYTES TO CLEAR
	ADD	#2,R5		;CLEAR SCRATCH WORD, TOO
50$:	CLRB	(R0)+
	SOB	R5,50$		;CLEAR IT ALL
	TST	R4		;RETURN SIZE?
	BEQ	60$		; NOPE
	MOV	R1,(R4)		; YES, SET IT UP
60$:
ERRRET:	POP	R5		;RETURN IERR?
	BEQ	70$		; NO
	MOVB	GCLBLK+G.ERR,(R5)
70$:	POP	R5		;RETURN FERR?
	BEQ	80$		; NO
	MOVB	GCLBLK+F.ERR,(R5)
80$:	BR	RCTRET		;FINISH OFF LAST ARG

;+
;	CALL  RESCMD ( [IERR] [,FERR] [,RCTL] )
;
;	RESETS INDIRECT COMMAND FILE SCANNING TO THE TOP LEVEL
;WHERE:
;		IERR	- LOGICAL*1 GCML ERROR RETURN CODE
;		FERR	- LOGICAL*1 FCS ERROR RETURN CODE
;		RCTL	- L*1 RETURNS DEVICE CHAR BYTE OF INPUT DEVICE (F.RCTL)
;-
	MFSUBR	RESCMD		;SET LINK
	MFARG	3		;ALL OPTIONAL ARGS
	RCML$	#GCLBLK		;RESET TO READ TOP-LEVEL
	BR	ERRRET		;PROCESS ERROR PARAMETERS


;+
;	CALL  CLOCMD ( [IERR] [,FERR] [,RCTL] )
;
;	CLOSES THE CURRENT COMMAND FILE
;WHERE:
;		IERR	- LOGICAL*1 GCML ERROR RETURN CODE
;		FERR	- LOGICAL*1 FCS ERROR RETURN CODE
;		RCTL	- L*1 RETURNS DEVICE CHAR BYTE OF INPUT DEVICE (F.RCTL)
;-
	MFSUBR	CLOCMD		;SET LINK
	MFARG	3		;ALL OPTIONAL ARGS
	CCML$	#GCLBLK		;RESET TO READ TOP-LEVEL
	BR	ERRRET		;PROCESS ERROR PARAMETERS


	.END