;
;	AUTHOR:
;		R. STODOLA
;		THE INSTITUTE FOR CANCER RESEARCH
;		7701 BURHOLME AVE.
;		PHILADELPHIA, PA.  19111
;
;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
;      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
;      *         NIH CA06927                                 *
;      *         NIH CA22780                                 *
;      *                                                     *
;      *      DIRECT INQUIRIES TO:                           *
;      *            COMPUTER CENTER                          *
;      *            THE INSTITUTE FOR CANCER RESEARCH        *
;      *            7701 BURHOLME AVENUE                     *
;      *            PHILADELPHIA, PENNSYLVANIA   19111       *
;      *                                                     *
;      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
;      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
;      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
;      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
;      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
;      *      OWNED RIGHTS.                                  *
;      *                                                     *
;      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
;      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
;      *      THE USE OF THIS SOFTWARE                       *
;      *                                                     *
;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
;      *      PDP-11/70 OPERATING UNDER IAS V2.0 USING       *
;      *      THE IAS PDP-11 MACRO ASSEMBLER.                *
;      *                                                     *
;      *******************************************************
	.TITLE	TAPCMD -- FETCH COMMAND LINE FOR TAPCON
	.SBTTL	TAPCMD -- DOCUMENTATION.
	.IDENT	/ICR001/
;
;	THIS ROUTINE WILL FETCH A COMMAND LINE FOR TAPCON.  WHEN
;	INSTALLED AS A SYSTEM LIBRARY TASK, THE CALLING SEQUENCES
;	ARE:
;	1.	INPUT FROM TAPE:
;		TAPE/IN[:DEV:[FILE#][:#RECS_TO_SKIP]]<QUALIFIERS> OUTFIL[<FILE QUALIFIERS>]
;		QUALIFIERS ARE:
;			/DUMP[/DEC10][/PE]
;			/LENGTH:<N>[/EBCDIC][/PE]
;			/LINE[:<MAX-SIZE>][/EBCDIC][/PE]
;		FILE QUALIFIERS ARE:
;			/STRIP
;			/LENGTH:<N>
;
;	2.	OUTPUT TO TAPE:
;		TAPE/OUT[:DEV:[FILE#][:#RECS_TO_SKIP]]<QUALIFIERS> OUTFIL
;		QUALIFIERS ARE:
;			/DUMP:<N>[/DEC10][/NOTAB][/STRIP OR /LENGTH:<N>][/PE]
;			/BLOCK[:<N>]/LENGTH:<N>[/EBCDIC][/NOTAB][/PE]
;			/LINE[:<MAX-SIZE>][/EBCDIC][/STRIP][/NOTAB][/PE]
;
;	*****  NOTE  *****
;	THIS ROUTINE MUST BE LINKED WITH OPTION ASG=TI:3
;
;	CALLING SEQUENCE IS:
;		CALL TAPCMD(IER)
;	IER   -- AN ERROR CODE RETURNED AS FOLLOWS:
;		IF <0:	LOW BYTE CONTAINS GCML ERROR CODE.
;		IF =0:	SUCCESSFUL COMPLETION.
;		IF >0:	ERROR DURING COMMAND INTERPRETER:
;			1 = DURING CSI$1
;			2 = DURING FIRST CALL TO CSI$2
;			3 = DURING SECOND CALL TO CSI$2
;			4 = EQUALS SIGN, WILD CARD OR TOO MANY FILE SPECS.
;			5 = NO FILE SPEC(OR BLANK).
;
;	DATA IS RETURNED INTO NAMED COMMON BLOCKS:
;		BYTE FILENM
;		COMMON/TAPTAB/ISWIT,NSWIT,IDEV,IDNM,IFIL,IRECNM,IDUMP,LEN,IBLK,ILINE
;		COMMON/FILTAB/JSWIT,JLEN,FILENM(40)
;
;	ISWIT:  TAPE SWITCH BIT MAP AS FOLLOWS:
TMDU=1		;/DUMP PRESENT
TMDE=2		;/DEC10 PRESENT
TMPE=4		;/PE PRESENT
TMLE=10		;/LENGTH PRESENT
TMEB=20		;/EBCDIC PRESENT
TMLI=40		;/LINE PRESENT
TMST=100	;/STRIP PRESENT
TMTA=200	;/TAB PRESENT
TMBL=400	;/BLOCK PRESENT
TMOU=1000	;/OUT PRESENT
TMIN=2000	;/IN PRESENT
;	NSWIT:	NEGATION INDICATOR FOR /TAB
;	IDEV:	FIRST TWO CHARACTERS OF DEVICE SWITCH
;	IDNM:	SECOND TWO CHARACTERS OF DEVICE SWITCH
;	IFIL:	FILE NUMBER 
;	IRECNM:	NUMBER OF RECORDS TO SKIP AFTER FILE POSITIONING
;	IDUMP:	DUMP NUMBER
;	LEN:	LENGTH NUMBER
;	IBLK:	BLOCK NUMBER
;	ILINE:	MAXIMUM LINE LENGTH
;
;	JSWIT:	FILE SWITCH INDICATORS (ONLY STRIP OR LENGTH ARE POSSIBLE).
;	JLEN:	LENGTH NUMBER
;	FILENM:	FILE NAME SUITABLE FOR USE WITH OPEN STATEMENT.
;
	.SBTTL	TAPCMD -- NAMED COMMON BLOCKS
	.PSECT	TAPTAB,D,GBL,REL,OVR
ISWIT=.
NSWIT=.+2
IDEV=.+4
IDNM=.+6
IFIL=.+8.
IRECNM=.+10.
IDUMP=.+12.
LEN=.+14.
IBLK=.+16.
ILINE=.+18.
.=.+20.
;
	.PSECT	FILTAB,D,GBL,REL,OVR
JSWIT=.
JLEN=.+2
FILENM=.+4
.=.+44.
;
	.SBTTL	TAPCMD -- GCML AND CSI BLOCKS
	.PSECT
	.MCALL	GCMLB$,GCML$,RCML$
	.MCALL	CSI$,CSI$1,CSI$2,CSI$SW,CSI$SV,CSI$ND
;
;	GCML BLOCK.
;
GBLK:	GCMLB$	3.,TAP,,3.
;
;	"FILE>" PROMPT STRING, LENGTH
;
FPR:	.ASCII	<15><12>/FILE>/
FP.LEN=.-FPR
	.EVEN
;
;	CSI BLOCK.
;
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.EVEN
;
;	TAPE SWITCH TABLE
;
TSWIT:	CSI$SW	OU,TMOU,,,,OUVT
	CSI$SW	IN,TMIN,,,,OUVT
	CSI$SW	DU,TMDU,,,,DUVT
	CSI$SW	DE,TMDE
	CSI$SW	PE,TMPE
	CSI$SW	LE,TMLE,,,,LEVT
	CSI$SW	EB,TMEB
	CSI$SW	LI,TMLI,,,,LIVT
	CSI$SW	ST,TMST
	CSI$SW	TA,TMTA,,,NEG
	CSI$SW	BL,TMBL,,,,BLVT
	CSI$ND
;
;	FILE SWITCH TABLE
;
FSWIT:	CSI$SW	LE,TMLE,,,,L2VT
	CSI$SW	ST,TMST
	CSI$ND
;
;	SWITCH VALUE TABLE: /OUT, /IN
;
OUVT:	CSI$SV	ASCII,IDEV,3
	CSI$SV	DECIMAL,IFIL,2
	CSI$SV	DECIMAL,IRECNM,2
	CSI$ND
;
;	SWITCH VALUE TABLE: /DUMP
;
DUVT:	CSI$SV	DECIMAL,IDUMP,2
	CSI$ND
;
;	SWITCH VALUE TABLE: /LENGTH (TAPE)
;
LEVT:	CSI$SV	DECIMAL,LEN,2
	CSI$ND
;
;	SWITCH VALUE TABLE: /LINE
;
LIVT:	CSI$SV	DECIMAL,ILINE,2
	CSI$ND
;
;	SWITCH VALUE TABLE: /BLOCK
;
BLVT:	CSI$SV	DECIMAL,IBLK,2
	CSI$ND
;
;	SWITCH VALUE TABLE: /LENGTH (FILE)
;
L2VT:	CSI$SV	DECIMAL,JLEN,2
	CSI$ND
	.SBTTL	TAPCMD -- DEFINE GCML ERROR CODE BYTES.
ECIOR=GE.IOR			;I/O ERROR OCCURED DURING COM. INP.
ECOPR=GE.OPR			;GCML UNABLE TO OPEN COMMAND FILE
ECBIF=GE.BIF			;INDIRECT COMMAND FILENAME SYN. ERR.
ECMDE=GE.MDE			;NESTING LEVEL TO DEEP.
ECEOF=GE.EOF			;EOF, COMMAND LEVEL 0.
;
	.SBTTL	TAPCMD -- MAIN CODE
;
;	ENTRY
;
TAPCMD::
	CLR	IDEV			;INITIALIZE COMMON
	CLR	IDNM
	MOV	#-1,R0
	MOV	R0,IFIL
	MOV	R0,IRECNM
	MOV	R0,IDUMP
	MOV	R0,LEN
	MOV	R0,IBLK
	MOV	R0,JLEN
;
	MOV	R0,@2(R5)		;SET ERROR CODE NEGATIVE.
	GCML$	#GBLK			;GET COMMAND BLOCK
	BCS	BADGMC			;ERROR SET?
	MOV	GBLK+G.CMLD+2,R2	;NO ERROR, SO SCAN FOR SPACE.
	MOV	GBLK+G.CMLD,R1
LOOPC:	DEC	R1			;IF NO SPACE, RETURN WITH ERROR 5.
	BMI	NOOUT
	CMPB	(R2)+,#40		;SEE IF SPACE.
	BNE	LOOPC			;NO, SO TRY NEXT.
COMMA=',
	MOVB	#COMMA,-(R2)		;FOUND SPACE -- INSERT COMMA.
NOOUT:	MOV	#1,@2(R5)		;SET ERROR CODE TO 1.
	MOV	GBLK+G.CMLD,CSIBLK+C.CMLD	;SET UP CSI$1 CALL.
	MOV	GBLK+G.CMLD+2,CSIBLK+C.CMLD+2
	CSI$1	#CSIBLK			;DO INITIAL CHECK OF CML.
	BCS	RTN			;RETURN IF ERROR.
	MOV	#2,@2(R5)		;SET ERROR CODE TO 2.
	CSI$2	#CSIBLK,OUTPUT,#TSWIT	;GET TAPE SPEC.
	BCS	RTN			;RETURN IF ERROR
	MOV	CSIBLK+C.MKW1,ISWIT	;SAVE SWITCH BITS AND
	MOV	CSIBLK+C.MKW2,NSWIT	; NEGATION BITS.
	MOV	#4,@2(R5)		;SET FOR SYNTAX ERROR.
	BITB	#CS.EQU!CS.WLD!CS.DVF!CS.NMF!CS.DIF,CSIBLK+C.STAT
	BNE	RTN
	BITB	#CS.MOR,CSIBLK+C.STAT	;IS FILE SPEC IN THIS LINE?
	BNE	ONELIN			;YES
	MOV	#-1,@2(R5)		;NO, SO PROMPT FOR IT.
RETRY:	GCML$	#GBLK,#FPR,#FP.LEN
	BCC	OKGMCL
	CMPB	GBLK+G.ERR,#GE.EOF	;IF EOF, RETRY.
	BEQ	RETRY
BADGMC:	MOVB	GBLK+G.ERR,@2(R5)	;SAVE ERROR BYTE.
	CMPB	GBLK+G.ERR,#GE.EOF	;IF NOT EOF, FLUSH INDIRECTS.
	BEQ	RET
FLUSHC::
RTN:	RCML$	#GBLK			;FLUSH INDIRECT FILES.
RET:	RETURN
;
OKGMCL:	MOV	#1,@2(R5)		;SET FOR CSI$1 ERROR.
	MOV	GBLK+G.CMLD,CSIBLK+C.CMLD
	MOV	GBLK+G.CMLD+2,CSIBLK+C.CMLD+2
	CSI$1	#CSIBLK			;DO PRELIMINARY SCAN.
	BCS	RTN			;FLUSH AND RETURN IF ERROR.
ONELIN:	MOV	#3,@2(R5)		;SET ERROR CODE TO 3.
	CSI$2	#CSIBLK,OUTPUT,#FSWIT	;GET FILE SPEC.
	BCS	RTN			;RETURN IF ERROR
	MOV	CSIBLK+C.MKW1,JSWIT	;SAVE SWITCH BITS.
	MOV	#4,@2(R5)		;SET ERROR CODE TO 4.
	BITB	#CS.EQU!CS.WLD!CS.MOR,CSIBLK+C.STAT	;CHECK FOR BAD.
	BNE	RTN			;RETURN IF BAD BITS SET.
;
;	MOVE FILESPEC INTO FILENM.
;
	MOV	#FILENM,R2
	BITB	#CS.DVF,CSIBLK+C.STAT	;DEVICE SPEC PRESENT?
	BEQ	NODEV			;NO.
	MOV	CSIBLK+C.DEVD+2,R1	;YES, SO MOVE TO FILENM.
	MOV	CSIBLK+C.DEVD,R0
	CALL	MOVIT
	MOVB	#':,(R2)+		;INSERT COLON AFTER DEVICE NAME.
NODEV:	BITB	#CS.DIF,CSIBLK+C.STAT	;DIRECTORY PRESENT?
	BEQ	NODIR			;NO.
	MOV	CSIBLK+C.DIRD+2,R1	;YES, SO MOVE TO FILENM.
	MOV	CSIBLK+C.DIRD,R0
	CALL	MOVIT
NODIR:	BITB	#CS.NMF,CSIBLK+C.STAT	;FILENAME PRESENT?
	BEQ	NOFNM			;NO.
	MOV	CSIBLK+C.FILD+2,R1	;YES, SO MOVE TO FILENM.
	MOV	CSIBLK+C.FILD,R0
	CALL	MOVIT
NOFNM:	MOV	#5,@2(R5)		;SET ERROR CODE TO 5.
	CMP	#FILENM,R2		;ERROR IF NO CHARACTERS.
	BEQ	RTN
	CLRB	(R2)			;CLEAR OUT FINAL BYTE.
	CLR	@2(R5)			;CLEAR ERROR CODE.
RTST:	RETURN
;
;	MOVIT -- MOVE R0 BYTES FROM (R1) TO (R2)
;
MOVIT:	DEC	R0
	BMI	RTST			;EXIT IF NO MORE BYTES.
	CMP	#FILENM+39.,R2		;MAKE SURE NOT TO OVERFLOW.
	BEQ	RTST			;LEAVE ROOM FOR FINAL NULL.
	MOVB	(R1)+,(R2)+		;MOVE BYTE.
	BR	MOVIT
	.END