/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/
/	RSX - BATCH  FILE PREPROCESSOR
	.TITLE	*FILES CARD PROCESSOR FOR RSX-PLUS BATCH
/
/	EDIT #2   GARY COLE      1/30/74
/	COPYRIGHT 1973 DIGITAL EQUIPMENT CORPORATION
/FILE IS A FORTRAN CALLABLE SUBROUTINE WHICH WILL READ *FILE CARDS
/	AND OPEN APPROPRIATE DATA FILE FOR SUBSEQUANT PROGRAM USE
/	THIS MAKE THE OPERATION OF PROGRAMS USING DISK DATA FILES
/	MUCH MORE CONVEINTENT IN BATCH OPERATION.
/
/
/	THE FORMAT OF THE *FILE CARD IS AS FOLLOWS
/
/*FILE  FILETYPE:LOGICALUNIT='FILENAME EXTENSION'
/
/	FILE TYPE IS : INPUT,OUTPUT
/	LOGICAL UNIT IS : AN INTEGER 1 TO 64
/	FILENAME IS: A ONE TO 6 CHARACTER FILE NAME
/	EXTENSION IS A 1 TO 3 CHARACTER NAME
/
/	THESE FILE SPECIFICATIONS MAY BE REPEATED ON ONE LINE
/	TO OPERATE SEVERAL FILES.
/
/
/	IF MORE FILE SPECIFICATIONS ARE NEEDED THAN WILL FIT ONTO
/	ON LINE A TERMINATION SYMBOL IS USED
/
/	THE TERMINATION SYMBOL IS $
/
/
/
/	THE FILE CARDS ARE LISTED ONTO LUN 16 AS THEY ARE READ.
/
	.EJECT
FILES	0	/FORTRAN ENTRY POINT  NO ARGUMENTS PASSED
	LAC	(LUNS)	/RESET LIST OF LUNS USED
	DAC	LIST
	DZM	EC
	DZM	EV
CARD	CAL	READCD	/READ A *FILE CARD
	CAL	WAIT
	CAL	WRCD	/PRINT ONTO LINE PRINTER
	CAL	WAIT
	DZM	CONTS	/SET THE CONTINUATION FLAG TO ZERO
	LAC	LN+2	/CHECK FOR '*FILE'
	SAD	FILS
	SKP
	JMP	ERR01
			/NOT A *FILE CARD READ
	LAC	LN+3
	SAD	FILS+1
	SKP
	JMP	ERR01
	JMS	INGCH	/INITIALIZE GET CAHRACTER ROUTINE
GETSP	JMS	INSCH	/INTI SAVE CHAR ROUTINE, PROCESS NEXT SPEC.
	JMS	GCH	/LOOK FOR FILE TYPE
	JMP	ERR02	/HIT DELIM TOO SOON--NOT FILE TYPE FORUND
	DAC	FTYP	/SAVE FIRST CHAR OF FILE TYPE(I,O)
	JMS	GCH
	SKP
	JMP	.-2	/SKAN FOR DELIM
	SAD	COLON	/IS IT A :
	SKP		/YES, PROCEED TO LOOK AT LUN NUMBER
	JMP	ERR03	/NO, MISSING : IN FILE SPECIFICATION
	JMS	GCH
	JMP	ERR04	/MISSING LUN, NOTHING BETWEEN : AND NEXT DELIM
	JMS	CNUM	/CONVERT TO A NUMBER 0-9
	JMP	ERR05	/LUN IS NOT A DIGIT
	DAC	LUN
	.EJECT
F02	JMS	GCH	/GET SECOND DIGIT OF LUN
	JMP	F03	/ON DELIM
	JMS	CNUM
	JMP	ERR05	/NOT A DIGIT AGAIN
	DAC	TEMP	/SAVE DIGIT
	LAC	LUN
	TAD	LUN
	DAC	LUN
	RAL!CLL
	RAL!CLL
	TAD	LUN
	TAD	TEMP	/ADD IN LOWER DIGIT
	DAC	LUN	/THIS IS THE LOGICAL UNIT NUMBER
	JMS	GCH
	JMP	F03
	JMP	ERR06	/TOO MANY DIGITS IN LUN!-WHAT DO YOU THINK THIS IS
F03	SAD	EQUAL	/LOOK FOR =
	SKP
	JMP	ERR07	/MISSING = SIGN IN FILE SPEC.
	JMS	GCH
	SKP
	JMP	ERR08	/MISSING QOUTE SIGN
F04	JMS	GCH
	JMP	F05	/GET CHARACTERS OF THE FILE NAME
	JMS	STCH	/STORE IN ARRAY
	JMP	F04	/LOOP
F05	SAD	SPACE	/WAS NAME TERMINATED BY SPACE?
	JMP	EXT	/YES LOOK FOR EXTENSION
	SAD	QUOTE	/WAS IT A QUOTE
	JMP	ENN	/YES ASSUME DEFAULT EXTENSION
	JMP	ERR09	/INVALID DELIMITER IN FILE NAME
ENN	JMS	STPK	/PACK THE STORED CHARACTERS INTO SIXBIT
	FILN
	LAC	DEFEXT
	DAC	EXTN
	JMP	FX7	/PROCESS FILE SPECIFICATION
	.EJECT
EXT	JMS	STPK	/PACK UP THE FILE NAME
	FILN
	JMS	INSCH
F06	JMS	GCH
	JMP	F07	/SCAN OFF THE FILE EXTENSION
	JMS	STCH	/STORE EACH CHARACTER
	JMP	F06	/LOOP
F07	SAD	SPACE	/SHOULD NOT TERMINATE ON SPACE
	JMP	ERR09	/PROBABLY RUNON STRING,MISSING QOUTE
	JMS	STPK
	EXTN
FX7	LAC	FTYP	/TAKE INTO ACCOUNT THE FILE DIRECTION
	SAD	INPUT	/CODE FOR 'I'
	JMP	F08
	SAD	OUTPUT
	JMP	F09
	JMP	ERR10	/ILLEGAL FILE TYPE
F08	LAC	(3200)
	JMP	F10
F09	LAC	(3300)	/ENTER FILE
F10	DAC	FCPB
	CAL	FCPB
	CAL	WAIT
	LAC	EV
	SMA
	JMP	OK		/FILE OPERATION SUCESSFUL
	JMP	FERR		/FILE OPERATION ERROR
FCPB	0
	EV
LUN	0
FILN	0
	0
EXTN	0
	0		/EXTRA WORD FOR STPK
	.EJECT
FERR	LAC	EV
	SAD	(-6
	JMP	OK	/IF DEVICE IS NOT FILE ORIENTED
	SAD	(-13
	JMP	ERR11
	SAD	(-55
	JMP	ERR12
	SAD	(-56
	JMP	ERR13	/NOT ENOUGH CORE
	SAD	(-102
	JMP	ERR14	/LUN IS NOT ASSIGNED
	SAD	(-103	/
	JMP	ERR14
	SAD	(-777)
	JMP	ERR15	/EMPTY POOL
	SAD	(-10)
	JMP	CLS	/FILE IS NOW OPEN, TRY TO CLOSE AND RETRY
	JMP	ERR16	/GENERAL ERROR IN *FILE OPERATION
CLS	LAC	LUN	/GET LUN IN USE
	DAC	L2
	CAL	CLSCPB	/CLOSE THE FILE
	CAL	WAIT	/
	LAC	EV
	SMA		/DID WE DO IT
	JMP	F10+1	/YES, RETRY THE FILE OPER
	JMP	ERR17	/CANNOT FORCE FILE CLOSED..
OK	LAC	FTYP	/GET FILE TYPE
	SWHA		/CONCANTANATE IT WITH THE LUN
	TAD	LUN
	DAC*	LIST
	ISZ	LIST
	JMP	GETSP
END	LAC	CONTS
	SNA		/EXIT NOW IF TERMINATOR FORUND
				/THIS IS A $ OUTSIDE OF QOUTES
	JMP	CARD
	DZM*	LIST	/MAKE LAST ENTRY ZERO FOR FILUNS
	JMP*	FILES	/RETURN TO CALLER
CLSCPB	3400
	EV
L2	0
	0
	0
	0
	.EJECT
STCH	0	/STORE ACHARACTER SUBROUTINE
		/CALL WITH CHAR IN AC
		/PUT CHAR INTO LIST STARTING AT SBUF
	DAC*	SCHR
	ISZ	SCHR
	ISZ	SCNT
	SKP
	JMP	ERR18	/FILE NAME TOO LONG
	JMP*	STCH
INSCH	0
	LAC	(-10
	DAC	SCNT
	LAC	(SBUF
	DAC	SCHR
	JMP*	INSCH
SBUF	.BLOCK 12
SCHR	0
SCNT	0
	.EJECT
GCH	0		/GET THE NEXT CHARACTER ROUTINE
			/THIS GETS A CHAR FOR  THE INPUT LINE AND RETURNS
			/IT IN THE AC
			/IT RETURNS TO CALL +1 IF IT IS A DELIM.
			/OR CALL+2 IF NO
			/DELIMS ARE SENSED IN ONE OF TWO MODES
			/MODE IS SWITCH BY A ' MARK
			/MODE 1, DELIMS ARE :='()
			/MODE 2,DELIMS ARE ' SPACE
			/IN MODE 1 BLANKS ARE IGNORED
			/$ ARE NOTED AND IGNORED
			/IN MODE 2 BLANKS ARE DELIM AND $ IS A CHAR.
NEXTCH	JMS	GT.CHR	/GET CHAR TO AC
	DAC	CHR
	SAD	CRTN
	JMP	END	/END OF LINE
	SAD	ALTM
	JMP	END
	LAC	MODE
	SPA
	JMP	QON	/MODE TWO IF NEGATIVE
QOFF	LAC	CHR
	SAD	SPACE
	JMP	NEXTCH	/IGNORE SPACE
	SAD	EQUAL
	JMP*	GCH
	SAD	COLON
	JMP*	GCH
	SAD	QUOTE
	JMP	QQON	/CHANGE STATE OF QOUTE SWITH AND FUTURE MODE
	SAD	OPARN
	JMP*	GCH
	SAD	CPARN
	JMP*	GCH	/PARENS ARE DELIMITERS FOR FUTURE EXPANSION
	SAD	COMMA
	JMP	NEXTCH	/IGNORE COMMA
	SAD	DOLLR
	JMP	GETCON
	ISZ	GCH
	JMP*	GCH	/RETURN TO CALL+2 WITH CHAR
QQON	LAC	MODE
	TCA		/REVERSE SIGN OF MODE
	DAC	MODE
	LAC	CHR
	JMP*	GCH
QON	LAC	CHR
	SAD	SPACE
	JMP*	GCH
	SAD	QUOTE
	JMP	QQON
	ISZ	GCH
	JMP*	GCH
	.EJECT
INGCH	0		/INITIALIZE GET A CHARACTER
	LAC	(LN)
	JMS	GT.FST
	JMS	GT.CHR
	JMS	GT.CHR
	JMS	GT.CHR
	JMS	GT.CHR
	JMS	GT.CHR	/SKIP OVER *FILE
	CLA!IAC
	DAC	MODE	/START IN MODE 1
	JMP*	INGCH
MODE	0
CHR	0
GETCON	ISZ	CONTS
	JMP	NEXTCH
	.EJECT
CNUM	0	/CONVERT A CHARACTER TO A DIGIT OR ELSE AN ERROR RTN
	AAC	-60
	SPA
	JMP*	CNUM	/CHAR IS LESS THAN "0"
	AAC	-13
	SMA		/CHAR IS GTEQ "9"
	JMP*	CNUM
	AAC	13
	ISZ	CNUM
	JMP*	CNUM	/RETURN WITH DIGIT IN AC
/  SUBROUTINE TO PACK CHARACTERS INTO SIXBIT 
STPK	0	/CALLED WITH ONE ARGUMENT, ADDRESS OF TWO WORD AREA
		/TO PUT DATA
	LAC*	STPK	/GET ARG
	DAC	DATAD	/SAVE
	ISZ	STPK	/SET RETURN ADDRESS
STLP	DZM*	SCHR
	ISZ	SCHR
	ISZ	SCNT
	JMP	STLP	/LOOP UNTIL BUFFER FILLED
	JMS	INSCH	/RESET POINTERS TO BUFFER
	JMS	PACK	/PACK THREE CHAR
	JMS	PACK	/PACK THREE CHAR
	JMP*	STPK
PACK	0
	LAC*	SCHR
	ISZ	SCHR
	AND	(77)
	RTL!CLL
	RTL
	RTL
	DAC	DATA
	LAC*	SCHR
	ISZ	SCHR
	AND	(77)
	TAD	DATA
	RTL!CLL
	RTL
	RTL
	DAC	DATA
	LAC*	SCHR
	ISZ	SCHR
	AND	(77)
	TAD	DATA
	DAC*	DATAD
	ISZ	DATAD
	JMP*	PACK
DATAD	0
DATA	0
	.EJECT
/	ERROR PROCESSING
ERR19	ISZ	EC
ERR18	ISZ	EC
ERR17	ISZ	EC
ERR16	ISZ	EC
ERR15	ISZ	EC
ERR14	ISZ	EC
ERR13	ISZ	EC
ERR12	ISZ	EC
ERR11	ISZ	EC
ERR10	CLA!IAC
	DAC	EC10
	JMP	EPRT
ERR09	ISZ	EC
ERR08	ISZ	EC
ERR07	ISZ	EC
ERR06	ISZ	EC
ERR05	ISZ	EC
ERR04	ISZ	EC
ERR03	ISZ	EC
ERR02	ISZ	EC
ERR01	ISZ	EC
 
EPRT	CLQ
	LAC	EC10
	LLS	7
	TAD	EC
	LLS	4
	TAD	XWRD
	DAC	XWRD
	CAL	WRERR
	CAL	WAIT
	CAL	(10		/EXIT AFTER LISTING ERROR MESSAGE
	.EJECT
WRERR	2700
	EV
	20
	2
	ERBUF
	EREND-ERBUF
ERBUF	EREND-ERBUF/2*1000+2; 0
	.ASCII	/ *FILE ACCESS ERROR #    /
XWRD	.ASCII	/00   /
	.ASCII	/-- PROGRAM TERMINATED/<15>
EREND=.
	.DEC
	46
ZERO	48
CRTN	13
ALTM	27
COLON	58
DOLLR	36
SPACE	32
INPUT	73
OUTPUT	79
QUOTE	39
OPARN	40
CPARN	41
COMMA	44
EQUAL	61
	.OCT
	.EJECT
/	ACSII UNPACKING SUBROUTINE  STOLEN FROM THE DOS MANUAL
/
GT.FST	0
	DAC	GT.TMP
	TAD	L2X
	DAC	GT.PTR
	LAW	-1
	DAC	GT.5
	LAC	GT.TMP
	JMP*	GT.FST
GT.CHR	0
	ISZ	GT.5
	JMP	GT.MO
	LAC*	GT.PTR
	ISZ	GT.PTR
	DAC	GT.WD1
	LAC*	GT.PTR
	ISZ	GT.PTR
	DAC	GT.WD2
	LAW	17773
	DAC	GT.5
GT.MO	LAW	17770
	DAC	GT.WD3
GT.LUP	LAC	GT.WD2
	RAL
	ISZ	GT.WD3
	JMP	GT.MOR
	AND	L177
	SAD	SPACE
	JMP	GT.EXT
GT.EXT	JMP*	GT.CHR
GT.MOR	DAC	GT.WD2
	LAC	GT.WD1
	RAL
	DAC	GT.WD1
	JMP	GT.LUP
GT.PTR	0
GT.5	0
GT.WD1	0
GT.WD2	0
GT.WD3	0
GT.TMP	0
L2X	2
L177	177
	.EJECT
/MISC  DATA
READCD	2600
	EV
	14
	2
	LN
	42
WRCD	2700
	EV
	20
	2
	LN
	42
WAIT	20
	EV
EV	0
LN	.BLOCK	42
	064000		/TERMINATOR FOR CARD OPERATION
CONTS	0
EC	0
EC10	0
TEMP	0
FILS	.ASCII	/*FILE/
FTYP	0
DEFEXT	.SIXBT	/SRC/
LIST	LUNS
LUNS	.BLOCK	20	/ALLOW 16 FILES OPEN
	.GLOBL	FILES,FILUNS,.DA
	.TITLE *FILES ROUTINE   FILUNS SUBROUTINE
/
/	FILUNS IS USED BY THE PROGRAMMER TO
/	ASCERTAIN THE LOGICAL UNIT NUMBERS ASSIGNED BY THE *FILE
/	CARDS. HE VISUALIZES THIS AS A MEANS OF FINDING THE
/	FIRST,SECOND,THIRD AND SUBSEQUANT INPUT FILES SPECIFIED,
/	AND THE FIRST,SECOND,THIRD,AND SUBSEQUANT OUTPUT FILES 
/	SPECIFIED BY THE USER. THIS ALLOWS THE PROGRAMMER TO BE 
/	QUITE DEVICE INDEPENDENT.
/
/	FILUNS IS CALLED IN THE FOLLOWING MANNER
/
/	CALL FILUNS(N,TYPE,LUN1,LUN2,LUN3......)
/
/	N IS THE NUMBER OF FILES OF THE TYPE NEEDED
/	TYPE IS EITHER 'I' OR 'O' ('INPUT','OUTPUT' IS OK AS WELL)
/	LUN1....N ARE SIMPLE INTEGER VARIABLES
/	INTO WHICH FILUNS WIL PUT THE LUN NUMBERS FOR EACH FILE
/
/	IF THE CORRECT NUMBER OF FILES CANNOT BE FOUND THE
/	MESSAGE *FILE ACCESS ERROR #19 -- PROGRAM TERMINATED
/
/	IS ISSUED AND FILUNS FORCES THE PROGRAM TO TERMINATE
/	BY ISSUING AN EXIT.
/
/
	.EJECT
FILUNS	0
	JMS*	.DA
	JMP	.+1+14
CNTF	0
TYPF	0
LF1	0
LF2	0
LF3	0
LF4	0
LF5	0
LF6	0
LF7	0
LF8	0
LF9	0
LF10	0
	LAC	(LF1)	/GET ADDRESS OF FIRST PARAMETER
	DAC	LTP
	LAC	(LUNS)	/ADDRESS OF LIST OF LUNS, LAST WORD IN LIST IS ZERO
	DAC	FTP
	LAC*	TYPF	/GET ASCII TYPE
	CLL!RTR		/ROTATE RIGHT TWO PLACES
	AND	(177000)
	DAC	TEMPF	/SAVE FOR COMPARISON WITH STORED TYPE
	LAC*	CNTF	/GET NUMBER OF FILES NEEDED
	TCA
	DAC	CTP	/SAVE ISZ ABLE COUNT
	.EJECT
LFLOP	LAC*	FTP	/GET ENTRY IN LUN LIST
	SNA		/END OF LIST IS MARKED BY A ZERO
	JMP	ERR19
	AND	(177000)	/COMPARE CHARACTER
	SAD	TEMPF
	JMP	OKF	/PROPER TYPE
LFLOP1	ISZ	FTP
	JMP	LFLOP
 
OKF	LAC*	LTP
	ISZ	LTP
	DAC	TEMP
	LAC*	FTP
	AND	(777)	/GET REAL LUN NUMBER
	DAC*	TEMP
	ISZ	CTP	/ARE WE DONE?
	JMP	LFLOP1	/NO
	JMP*	FILUNS	/YES, RETURN HAPPLYLY TO USER
 
LTP	0
TEMPF	0
FTP	0
CTP	0
	.END