.TITLE	TAPEIMAGE
	.IDENT	-010000-
;+
; ABSTRACT:	TAPEIMAGE
;
;	THIS PROGRAM MOVES DATA FROM THE MT: TO DISK FILES.
;	THE PURPOSE OF IT IS TO MOVE DATA WHICH IS ON THE MT:
;	IN IMAGE FORMAT, AND CANNOT BE MOVED IN THE NORMAL
;	WAY EITHER WITH $UNTAPE (FOR RECORDS ON THE TAPE WHICH
;	ARE FIXED AND WHICH ARE TO BE MOVED TO THE DISK INTO
;	VARIABLE-LENGTH RECORDS) OR WITH ...PIP OR $READTAPE
;	(WHICH BOTH REQUIRE AN ANSII STANDARD MAGTAPE). IT
;	WAS INTENDED ESPECIALLY FOR READING THE SOLO
;	OPERATING SYSTEM TAPES, WHICH HAVE A LINE-FEED FOR THE
;	DELIMETER BETWEEN LINES OF "VARYING-LENGTH-RECORD"
;	FILES (AS UNIX OR RT-11). IT ALSO SHOULD PROVE USEFUL
;	IN READING/WRITING TAPES FROM THE MED-II COMPUTER
;	IN NUCLEAR CARDIOLOGY, WHICH IS A 12-BIT MACHINE WITH
;	A RATHER STRANGE BINARY TAPE FORMAT.
;
; OPERATING PROCEDURES:
;
;	THIS PROGRAM IS RUN BY SAYING RUN TAPEIMAGE. IT HAS
;	TWO AVAILABLE SWITCHES:
;
;		/IM	HANDLE DEVICE IN IMAGE MODE. THIS
;			BYPASSES ANY FILES-11 THINGS SUCH
;			AS FILES, VOLUME STRUCTURE, ETC. THE
;			DEVICE MUST BE MOUNTED AS FOREIGN.
;			IT IS NOT LEGAL TO SPECIFY A FILENAME
;			OR DIRECTORY ON THE SIDE OF THE COMMAND
;			WHICH HAS THIS SWITCH. THE SWITCH MAY
;			BE SPECIFIED ON EITHER OR BOTH SIDES
;			OF THE COMMAND, AND AFFECTS ONLY THE
;			SIDE (INPUT OR OUTPUT) ON WHICH IT
;			APPEARS. DEFAULT: /-IM
;		/SQ	SQUEEZE THE DATA AS IT IS TRANSFERRED.
;			THIS WILL CAUSE ANY DATA TRANSFERRED
;			TO BE PACKED TOGETHER. IF THIS SWITCH
;			IS NOT SPECIFIED, AND THE DATA IS IN
;			BLOCKS WHICH ARE NOT A MULTIPLE OF 512.,
;			THE DATA WILL BE PADDED SO THAT EVERY
;			BLOCK READ WILL BE ALIGNED TO THE NEXT
;			AVAILABLE BLOCK ON THE OUTPUT DEVICE.
;			IF THIS SWITCH IS SPECIFIED, THE DATA
;			WILL BE PACKED TOGETHER IN 512. BYTE
;			BLOCKS. THIS SWITCH IS NOT VALID IF THE
;			OUTPUT DEVICE IS SPECIFIED AS /IM.
;		/BS:NNN	SPECIFY BLOCK SIZE FOR IMAGE MODE
;			DEVICE.  IF THIS SWITCH IS SPECIFIED,
;			THE DATA WILL BE WRITTEN WITH THE
;			SPECIFIED BLOCK SIZE.  IF THIS
;			SWITCH IS NOT SPECIFIED, THE DEFAULT
;			BLOCK SIZE IS 512.
;
; LIMITATIONS:
;
;	AN IMAGE DEVICE MUST BE A DISK OR A MAGNETIC TAPE.
;
; WRITTEN: 19-NOV-78, -0.0.0-, BRUCE C. WRIGHT
; MODIFIED: 21-FEB-80, -1.0.0-, BRUCE C. WRIGHT
;	VARIOUS BUG FIXES AND ADDED /BS: SWITCH.
; VERIFIED:
;-

;
	.SBTTL	MACRO CALLS
 
	.MCALL	EXIT$S,QIOW$,ALUN$S
	.MCALL	OPEN$,CLOSE$,FINIT$
	.MCALL	WRITE$,WAIT$,READ$
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND,CSI$SV
	.MCALL	FDAT$R,FDRC$R,FDOP$R,FDBF$R,FDBK$R
	.MCALL	FSRSZ$,FDBDF$,NMBLK$,BDOFF$
 
	.MACRO	ONERR	ARG
	BCC	.+6
	JMP	ARG
	.ENDM
 
	.MACRO	JEQ	ARG
	BNE	.+6
	JMP	ARG
	.ENDM
 
	.MACRO	JNE	ARG
	BEQ	.+6
	JMP	ARG
	.ENDM
 
	.MACRO	ERROR	STRING,LEN,SEV
	MOV	STRING,R0
	MOV	LEN,R1
	.IF IDN	<SEV>,<CONT>
	CLR	R2
	.IFF
	MOV	#-1,R2
	.ENDC
	JMP	CMDQIO
	.ENDM
 
CMDLUN	=	1
INPLUN	=	2
OUTLUN	=	3
ERRLUN	=	4
NO.BLK	=	63.
 
	.SBTTL	PARAMETER SYMBOL DEFINITIONS
 
	BDOFF$	DEF$L
 
	.SBTTL	READ A COMMAND LINE
 
	.PSECT	CODE,RW,I
START:	FINIT$
	MOV	SP,SPSAVE
BEGIN:	MOV	SPSAVE,SP
	GCML$	#CMLBLK		;GET COMMAND LINE
	BCC	GETOK		;SKIP IF GOTTEN OK.
	CMPB	CMLBLK+G.ERR,#GE.IOR
	BEQ	CMDERR		;I/O ERROR
	CMPB	CMLBLK+G.ERR,#GE.OPR
	BEQ	CMDOPE		;OPEN ERROR
	CMPB	CMLBLK+G.ERR,#GE.BIF
	BEQ	CMDSYN		;SYNTAX ERROR
	CMPB	CMLBLK+G.ERR,#GE.MDE
	BEQ	CMDMAX		;MAX @ FILE DEPTH
	CMPB	CMLBLK+G.ERR,#GE.EOF
	BNE	CMDUNK		;EOF ON COMMAND FILE
	EXIT$S
CMDERR:	ERROR	#M.ERR,#L.ERR,FATAL
CMDOPE:	ERROR	#M.OPE,#L.OPE,CONT
CMDSYN:	ERROR	#M.SYN,#L.SYN,CONT
CMDMAX:	ERROR	#M.MAX,#L.MAX,CONT
CMDPS1:	ERROR	#M.PS1,#L.PS1,CONT
CMDPS2:	ERROR	#M.PS2,#L.PS2,CONT
CMDUNK:	ERROR	#M.UNK,#L.UNK,FATAL
CMDQIO:	MOV	R0,$QIOW+Q.IOPL+0
	MOV	R1,$QIOW+Q.IOPL+2
	MOV	#$QIOW,-(SP)
	CALL	.DIRDL
	MOV	#INFDB,R0	;GET INPUT FDB
	CALL	CLOSE		;CLOSE IT
	MOV	#OUTFDB,R0	;GET OUTPUT FDB
	CALL	CLOSE		;CLOSE IT
	TST	R2		;LEAVE YET?
	BEQ	BEGIN		;NO
	EXIT$S

GETOK:	TST	CMLBLK+G.CMLD
	BEQ	BEGIN
	CLR	SWORD		;CLEAR SWITCHES.
	MOV	#1000,BLKSIZ	;SET UP DEFAULT BLOCK SIZE.
	MOV	#INFDB,R0	; GET INPUT FDB
	CALL	CLRFDB		; CLEAR OUT THE INPUT FDB
	FDAT$R	R0,#R.FIX,,#1000 ; SET UP DEFAULT ATTRIBUTES.
	CSI$1	#CSIBLK,CMLBLK+G.CMLD+2,CMLBLK+G.CMLD
	  ONERR	CMDPS1
	BITB	#CS.EQU,CSIBLK+C.STAT
	JEQ	CMDPS1
	CSI$2	#CSIBLK,INPUT,#CSITAB
	  ONERR	CMDPS2
	BITB	#CS.WLD,CSIBLK+C.STAT
	JNE	CMDPS1
	BITB	#CS.MOR,CSIBLK+C.STAT
	JNE	CMDPS1
	CLR	R3		;ASSUME THAT INPUT IS FILES-11
	BIT	#SW.IM,SWORD	;IS /IM SPECIFIED?
	BEQ	NOIMI		;NOT ON THE INPUT!
	BIC	#SW.IM,SWORD	;FORCE NOT TO BE IMAGE FOR NEXT FILE.
	TST	CSIBLK+C.DIRD	;WAS A DIRECTORY SPECIFIED FOR IMAGE MODE?
	JNE	CMDPS1		;YES -- ILLEGAL.
	TST	CSIBLK+C.FILD	;HOW ABOUT A FILE NAME?
	JNE	CMDPS1		;YES -- ILLEGAL.
	MOV	#1,R3		;SHOW THAT THIS IS TO BE "IMAGE" MODE.
NOIMI:	MOV	#INFDB,R0	;GET INPUT FDB.
	MOV	#FO.RD,R1	;GET THE DIRECTION
	MOV	#INPLUN,R2	;GET THE LUN.
	CALL	OPEN		;"OPEN" THE FILE.
;
	CSI$2	#CSIBLK,OUTPUT,#CSITAB
	  ONERR	CMDPS2
	BITB	#CS.WLD,CSIBLK+C.STAT
	JNE	CMDPS1
	BITB	#CS.MOR,CSIBLK+C.STAT ;MORE?
	JNE	CMDPS1		;YES -- ERROR.
	CLR	R3		;ASSUME THAT OUTPUT IS FILES-11
	BIT	#SW.IM,SWORD	;IS /IM SPECIFIED?
	BEQ	NOIMO		;NOT ON THE OUTPUT!
	BIT	#SW.SQ,SWORD	;/IM ON OUTPUT CONFLICTS WITH /SQ.
	BEQ	10$		;NOT SPECIFIED, OK
	ERROR	#M.ISW,#L.ISW,CONT ;SIGNAL ERROR.
10$:	TST	CSIBLK+C.DIRD	;WAS A DIRECTORY SPECIFIED FOR IMAGE MODE?
	JNE	CMDPS1		;YES -- ILLEGAL.
	TST	CSIBLK+C.FILD	;HOW ABOUT A FILE NAME?
	JNE	CMDPS1		;YES -- ILLEGAL.
	MOV	#1,R3		;SHOW THAT THIS IS TO BE "IMAGE" MODE.
NOIMO:	MOV	#OUTFDB,R0	;GET OUTPUT FDB
	CALL	CLRFDB		; CLEAR OUT THE FDB
	FDAT$R	R0,INFDB+F.RTYP,INFDB+F.RATT,INFDB+F.RSIZ
	MOV	#FO.WRT,R1	;GET THE DIRECTION
	MOV	#OUTLUN,R2	;GET THE LUN.
	CALL	OPEN		;"OPEN" THE FILE.
	MOV	#OUTBUF,OUTPTR	;SET UP OUTPUT POINTER FOR /SQ MODE.

	.SBTTL	COPY THE FILE
 
	CLR	INBLK+2		;CLEAR INPUT BLOCK NUMBER.
	CLR	INBLK		;
	CLR	OUTBLK+2	;CLEAR OUTPUT BLOCK NUMBER.
	CLR	OUTBLK		;
	CMP	BLKSIZ,#BUFLEN	;IS BUFFER SIZE TOO LARGE?
	BLOS	5$		; NO -- KEEP GOING.
	ERROR	#M.SIZ,#L.SIZ,CONT ; YES -- ERROR MESSAGE.
5$:	BIT	#777,BLKSIZ	; IS IT A LEGAL MULTIPLE OF 512?
	BEQ	6$		; YES -- OK
	ERROR	#M.BUF,#L.BUF,CONT ; NO -- ERROR.
6$:	TST	INFDB-2		;INPUT = FILES-11?
	BNE	10$		;NO
	MOV	#1,INBLK+2	;INC BLOCK #
10$:	TST	OUTFDB-2	;OUTPUT = FILES-11?
	BNE	READ		;NO
	MOV	#1,OUTBLK+2	;INC BLOCK #
READ:	MOV	#INFDB,R0	;GET THE INPUT FDB.
	TST	-2(R0)		;IS IT A NORMAL FILE?
	BNE	10$		;NO
	MOV	F.EFBK+2(R0),R2	; GET LOW ORDER OF EOF BLOCK
	MOV	F.EFBK(R0),R1	; GET HIGH ORDER OF EOF BLOCK
	TST	F.FFBY(R0)	; IS THE FIRST FREE BYTE = 0?
	BEQ	4$		; YES, SKIP.
	ADD	#1,R2		; NO, INCREMENT HIGH BLOCK
	ADC	R1		; AND INCREMENT HI ORDER IF NEEDED.
4$:	SUB	F.BKVB(R0),R1	; COMPUTE NUMBER OF BLOCKS REMAINING
	SUB	F.BKVB+2(R0),R2	; ...
	SBC	R1		; SUBTRACT ANY BORROW FROM HI ORDER
	BNE	5$		; SKIP -- NO NEED TO ADJUST ANYTHING
	MOV	BLKSIZ,R1	; GET BLOCK SIZE.
	ASH	#-9.,R1		; COMPUTE # BLOCKS THIS WOULD MOVE.
	CMP	R1,R2		; IS IT > THE NUMBER REMAINING?
	BLO	5$		; NO, KEEP BLOCKSIZE FOR NOW.
	ASH	#9.,R2		; COMPUTE BLOCK SIZE TO READ REMAINDER.
	MOV	R2,BLKSIZ	; AND SET IT IN THE BLOCKSIZE WORD.
5$:	READ$	R0,#BUFFER,BLKSIZ ;READ THE RSX-11 FILE.
	  ONERR	EOFMOD
	WAIT$	R0		;WAIT FOR I/O
	  ONERR	EOFMOD		;
	MOV	BLKSIZ,IOST+2	;MOVE IN # OF CHARS TRANSFERRED.
	MOV	BLKSIZ,R1	; GET BLOCK SIZE.
	ASH	#-9.,R1		; COMPUTE NUMBER OF 512-BYTE BLOCKS IN IT
	ADD	R1,INBLK+2	;BUMP INPUT BLOCK #
	ADC	INBLK		;
	BR	WRITE		;AND WRITE IT.
10$:	MOV	#IO.RLB,QIO+Q.IOFN ;GET THE I/O FUNCTION CODE.
	MOV	#INPLUN,QIO+Q.IOLU ;LUN
	MOV	#BUFFER,QIO+Q.IOPL ;GET THE BUFFER.
	MOV	#BUFLEN,QIO+Q.IOPL+2 ;LENGTH
	MOV	INBLK,QIO+Q.IOPL+6 ;BLOCK NUMBER.
	MOV	INBLK+2,QIO+Q.IOPL+10 ;AND LOW ORDER TOO.
	MOV	#QIO,-(SP)
	CALL	.DIRDL		;DO MAGTAPE I/O
	  ONERR	MTERR		;ERROR?
	TSTB	IOST		;ERROR?
	BMI	MTERR		;YES.
	MOV	IOST+2,R1	;GET # OF BYTES TRANSFERRED.
	ADD	#777,R1		;ROUND UP TO NEXT BLOCK BOUNDARY.
	BIC	#777,R1		; ...
	ASH	#-9.,R1		;ADJUST FOR BLOCKS.
	ADD	R1,INBLK+2	;ADD INTO INPUT BLOCK #
	ADC	INBLK		;AND HIGH ORDER.
WRITE:	BIT	#SW.SQ,SWORD	;RUNNING IN SQUEEZE MODE?
	BNE	WRITES		;YES -- WRITE THE DATA IN SQUEEZE MODE.
	MOV	IOST+2,R1	;GET # OF CHARS TRANSFERRED.
	ADD	#777,R1		;GET TO NEXT HIGHEST BLOCK.
	BIC	#777,R1		;CLEAN LOW GARBAGE.
	MOV	#OUTFDB,R0	;GET THE OUTPUT FDB.
	TST	-2(R0)		;IS IT A NORMAL FILE?
	BNE	10$		;NO
	WRITE$	R0,#BUFFER,R1
	  ONERR	EOFMOD
	WAIT$	R0		;WAIT FOR I/O
	  ONERR	EOFMOD
	ADD	#1,OUTBLK+2	;INC BLOCK #
	ADC	OUTBLK		;...
	JMP	READ		;AND LOOP.
10$:	MOV	#IO.WLB,QIO+Q.IOFN ;SET I/O FUNCTION CODE
	MOV	#OUTLUN,QIO+Q.IOLU ;OUTPUT LUN
	MOV	R1,QIO+Q.IOPL+2 ;SET THE LENGTH.
	MOV	OUTBLK,QIO+Q.IOPL+6 ;SET HI ORDER LENGTH.
	MOV	OUTBLK+2,QIO+Q.IOPL+10 ;AND LOW ORDER LENGTH.
	MOV	#QIO,-(SP)	;DO MAGTAPE I/O
	CALL	.DIRDL		;
	  ONERR	MTERR		;LOOP ON NO ERROR
	TSTB	IOST		;TEST THE I/O STATUS
	BMI	MTERR		;SKIP IF ERROR
	MOV	IOST+2,R1	;GET # OF BYTES TRANSFERRED.
	ADD	#777,R1		;ROUND UP TO NEXT BLOCK.
	BIC	#777,R1		; ...
	ASH	#-9.,R1		;CONVERT FROM BYTES TO BLOCKS.
	ADD	R1,OUTBLK+2	;INC OUTPUT BLOCK #
	ADC	OUTBLK		;AND LOW ORDER.
	JMP	READ		;AND LOOP.
WRITES:	MOV	#BUFFER,R1	;POINT TO THE BUFFER.
	MOV	OUTPTR,R3	;POINT TO THE OUTPUT BUFFER.
	MOV	IOST+2,R2	;GET LENGTH OF THE BUFFER.
	BEQ	30$		;LEAVE IF NOTHING THERE.
10$:	CMP	R3,#OUTBUF+512.	;OVER CAPACITY OF OUTPUT BUFFER?
	BLO	20$		;NO -- CONTINUE.
	WRITE$	#OUTFDB,#OUTBUF,#1000 ;WRITE THE DATA.
	  ONERR	EOFMOD
	WAIT$	R0		;WAIT FOR I/O
	  ONERR	EOFMOD
	ADD	#1,OUTBLK+2	;INC OUTPUT BLOCK #
	ADC	OUTBLK		; ...
	MOV	#OUTBUF,R3	;AND POINT TO THE BUFFER AGAIN.
20$:	MOVB	(R1)+,(R3)+	;MOVE THE DATA INTO THE OUTPUT BUFFER.
	SOB	R2,10$		;AND LOOP OVER THE OUTPUT BUFFER.
30$:	JMP	READ		;AND READ THE NEXT BLOCK.
MTERR:	MOV	@#$DSW,F.ERR(R0) ;GET DSW ERROR
	BMI	10$		;SKIP IF THAT'S REALLY IT.
	MOVB	IOST,F.ERR(R0)	;GET IOST ERROR CODE
10$:	JMP	EOFMOD		;

	.SBTTL	OPEN THE FILES.
;
; THIS SUBROUTINE "OPENS" FILES. IT ALSO WILL ASSIGN LUNS TO
; DEVICES MARKED WITH "/IM" SWITCHES, IN EFFECT ACTING AS A
; PHONY "OPEN" STATEMENT FOR THEM.
;
; ON INPUT,
;
;	R0	FDB TO BE OPENED
;	R1	THE DIRECTION OF OPEN (INPUT OR OUTPUT)
;	R2	THE LUN ON WHICH THE FDB IS TO BE OPENED
;	R3	THE TYPE OF FILE TO BE OPENED.
;		0 = NORMAL FILE
;		1 = IMAGE MODE FILE
;
OPEN:	TST	R3		;IS THIS FILE AN IMAGE FILE?
	BNE	10$		;YES -- SPECIAL PROCESSING.
	CLR	-2(R0)		;SHOW THAT THIS IS A NORMAL FILE.
	FDRC$R	R0,#FD.RWM	;WE WILL USE READ/WRITE
	FDBK$R	R0		;BLOCK I/O MACRO
	FDOP$R	R0,R2,#CSIBLK+C.DSDS,#DFNB,R1 ;SET FILE OPEN ATTRIBUTES
	OPEN$	R0		;OPEN THE FILE.
	  ONERR	EOFMOD		;LEAVE IF ERROR.
	RETURN			;AND RETURN TO CALLER.
10$:	MOV	#1,-2(R0)	;SHOW THAT THIS IS AN IMAGE FILE.
	MOV	R0,-(SP)	;SAVE R0
	MOV	R1,-(SP)	;SAVE R1
	MOV	R2,-(SP)	;SAVE R2
	MOV	R3,-(SP)	;SAVE R3.
	MOVB	R2,F.LUN(R0)	;SET LUN IN FDB.
	MOV	#CSIBLK+C.DSDS,R2 ;GET THE DATASET DESCRIPTOR.
	MOV	#DFNB,R3	;GET THE DEFAULT FILENAME BLOCK
	MOV	R0,R1		;GET FILNAME BLOCK INTO R1
	ADD	#F.FNB,R1	;... POINT TO FNB
	CALL	.PRSDV		;PARSE THE DEVICE.
	  ONERR	90$		;ILLEGAL /IM DEVICE
	MOV	#IO.ATT,QIO+Q.IOFN
	MOV	2(SP),R2	; RECOVER LOGICAL UNIT #
	MOV	R2,QIO+Q.IOLU
	MOV	#QIO,-(SP)	;
	CALL	.DIRDL		;DO THE I/O
	  ONERR	MTERR		;/IM ERROR
	TSTB	IOST		;AN ERROR?
	BPL	40$		;NO
	JMP	MTERR		;/IM ERROR
40$:	CMP	F.FNB+N.DVNM(R0),#"MT ;IS IT A MT:?
	BEQ	45$		;YES -- SET CHARACTERISTICS
	CMP	F.FNB+N.DVNM(R0),#"MM ;OR AN MM: ?
	BNE	60$		;NO -- DON'T SET CHARACTERISTICS.
45$:	MOV	#IO.STC,QIO+Q.IOFN
	MOV	#20100,QIO+Q.IOPL
	CMP	4(SP),#FO.RD	;IS IT TO BE OPENED FOR READ?
	BEQ	50$		;YES -- SKIP
	MOV	#20000,QIO+Q.IOPL ;FIXUP CHAR WORD.
50$:	MOV	#QIO,-(SP)
	CALL	.DIRDL		;SET CHARACTERISTICS
	  ONERR	MTERR		;ERROR?
	TSTB	IOST		;ERROR?
	BPL	60$
	JMP	MTERR		;ERROR
60$:	MOV	(SP)+,R3	;RECOVER R3
	MOV	(SP)+,R2	;RECOVER R2
	MOV	(SP)+,R1	;RECOVER R1
	MOV	(SP)+,R0	;RECOVER R0
	RETURN
90$:	ERROR	#M.ILD,#L.ILD,CONT ;ILLEGAL /IM DEVICE.
CLRFDB:	MOV	R1,-(SP)	;SAVE SOME REGISTERS.
	MOV	R0,-(SP)	;
	MOV	#S.FDB/2,R1	;GET FDB SIZE
1$:	CLR	(R0)+		;CLEAR OUT FDB
	SOB	R1,1$		;AND LOOP.
	MOV	(SP)+,R0	;RECOVER REGISTERS
	MOV	(SP)+,R1	;
	RETURN			; AND RETURN TO THE CALLER.

	.SBTTL	CLOSE THE FILES.
;
; THIS IS A GENERALISED FILE-CLOSE ROUTINE. IT WILL CLOSE BOTH
; FILES-11 AND NON-FILES-11 FILES.
;
; ON INPUT,
;
;	R0	THE FDB OF THE FILE TO BE CLOSED
;
CLOSE:	TST	-2(R0)		;IS THIS A FILES-11 FILE?
	BNE	10$		;NO -- SPECIAL TREATMENT
	CLOSE$	R0		;CLOSE THE FILE
	RETURN			;AND RETURN.
10$:	MOV	#IO.DET,QIO+Q.IOFN ;GET DETACH
	MOVB	F.LUN(R0),QIO+Q.IOLU ;GET LUN
	MOV	#QIO,-(SP)	;GET THE DIRECTIVE
	CALL	.DIRDL		;AND DO THE QIO
	RETURN			;AND RETURN

	.SBTTL	PRINT ERROR MESSAGES
 
EOFMOD:
;
;	THE ERROR HANDLING ROUTINE.
;	IF AN END-OF-FILE IS DETECTED, THE PROGRAM JUST EXITS.
;
	CMPB	F.ERR(R0),#IE.EOF
	BEQ	ENDLOP		;YES, IS END-OF-FILE.
CMDOPN:	MOV	#M.IOR,R1	;GET I/O ERROR MSG
	MOV	#L.IOR,R2	;AND LENGTH
	TST	@#$DSW		;DSW ERROR?
	BGT	10$		;NO
	MOV	@#$DSW,F.ERR(R0) ;MOVE IN ERROR CODE
10$:	CALL	.PRFCS		;
ENDLOP:	MOV	#INFDB,R0	;GET INPUT FILE
	MOV	F.EFBK(R0),OUTFDB+F.EFBK
	MOV	F.EFBK+2(R0),OUTFDB+F.EFBK+2
	MOV	F.FFBY(R0),OUTFDB+F.FFBY
	CALL	CLOSE		;CLOSE IT
	BIT	#SW.SQ,SWORD	;IN SQUEEZE MODE?
	BEQ	10$		;NO, SKIP.
	BIT	#SW.TMP,SWORD	;RECURSING IN EOFMOD?
	BNE	10$		;YES, SKIP.
	BIS	#SW.TMP,SWORD	;PREVENT COMING HERE AGAIN.
	MOV	OUTPTR,R1	;GET THE OUTPUT POSITION.
	SUB	#OUTBUF,R1	;GET THE BYTE OFFSET.
	BEQ	5$		;SKIP IF 0.
	WRITE$	#OUTFDB,#OUTBUF,#1000 ;OUTPUT THE BUFFER.
	  ONERR	EOFMOD
	WAIT$	R0
	  ONERR	EOFMOD
	BR	6$		;AND SKIP USELESS CODE.
5$:	ADD	#1,OUTFDB+F.EFBK+2 ;ADD IN THE END-OF-FILE BLOCK.
	ADC	OUTFDB+F.EFBK	;AND THE HIGH ORDER.
6$:	MOV	R1,OUTFDB+F.FFBY ;SET FIRST FREE BYTE IN LAST BLOCK.
10$:	MOV	#OUTFDB,R0	;GET OUTPUT FILE
	CALL	CLOSE		;AND CLOSE IT.
	JMP	BEGIN

	.SBTTL	ERROR MESSAGE STRINGS
 
	.PSECT	PDATA,RO,D
	.NLIST	BIN
M.ERR:	.ASCII	"IMG -- I/O ERROR ON @ FILE"
L.ERR	=	.-M.ERR
M.OPE:	.ASCII	"IMG -- OPEN ERROR ON @ FILE"
L.OPE	=	.-M.OPE
M.SYN:	.ASCII	"IMG -- SYNTAX ERROR FOR @ FILE"
L.SYN	=	.-M.SYN
M.MAX:	.ASCII	"IMG -- MAX @ FILE DEPTH EXCEEDED"
L.MAX	=	.-M.MAX
M.UNK:	.ASCII	"IMG -- UNKNOWN COMMAND ERROR"
L.UNK	=	.-M.UNK
M.PS1:	.ASCII	"IMG -- SYNTAX ERROR"
L.PS1	=	.-M.PS1
M.PS2:	.ASCII	"IMG -- ILLEGAL SWITCH"
L.PS2	=	.-M.PS2
M.ILD:	.ASCII	"IMG -- ILLEGAL /IM DEVICE"
L.ILD	=	.-M.ILD
M.ISW:	.ASCII	"IMG -- CONFLICTING SWITCHES"
L.ISW	=	.-M.ISW
M.SIZ:	.ASCII	"IMG -- BUFFER SIZE TOO LARGE FOR AVAILABLE MEMORY"
L.SIZ	=	.-M.SIZ
M.BUF:	.ASCII	"IMG -- BUFFER SIZE MUST BE IN MULTIPLES OF 512."
L.BUF	=	.-M.BUF
M.IOR:	.ASCII	/IMG/
L.IOR	=	.-M.IOR
	.EVEN

	.SBTTL	DATA AREA
 
	.PSECT	IDATA,RW,D
CSITAB:	CSI$SW	IM,SW.IM,SWORD,SET,NEG
	CSI$SW	SQ,SW.SQ,SWORD,SET,NEG
	CSI$SW	BS,SW.BS,SWORD,SET,,BLKCSI
	CSI$ND
BLKCSI:	CSI$SV	OCTAL,BLKSIZ,2
	CSI$ND
SWORD:	.WORD	0
SW.IM	=	000001		;IMAGE MODE
SW.SQ	=	000002		;SQUEEZE MODE.
SW.BS	=	000004		;BLOCK SIZE
SW.TMP	=	100000		; *** TEMPORARY BIT ***
BLKSIZ:	.WORD	1000		; BLOCK SIZE
CMLBLK:	GCMLB$	1,IMG,USRBUF,CMDLUN
USRBUF:	.BLKB	82.
	.EVEN
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	FSRSZ$	1,S.BFHD+512.
	.PSECT	IDATA,RW,D
	.WORD	0		;FDB TYPE - MUST PRECEDE INFDB
INFDB:	FDBDF$
	.WORD	0		;FDB TYPE - MUST PRECEDE OUTFDB
OUTFDB:	FDBDF$
DFNB:	NMBLK$	,LST,,SY,0
	.EVEN
IOST:	.WORD	0,0
SPSAVE:	.WORD	0
OUTPTR:	.WORD	0		;POINTER INTO OUTBUF.
INBLK:	.WORD	0,0		;INPUT BLOCK NUMBER.
OUTBLK:	.WORD	0,0		;OUTPUT BLOCK NUMBER.
BUFFER:	.BLKB	NO.BLK*512.
BUFLEN	=	.-BUFFER
	.EVEN
OUTBUF:	.BLKB	1000
$QIOW:	QIOW$	IO.WVB,ERRLUN,ERRLUN,,,,<0,0,40>
QIO:	QIOW$	IO.RLB,,2,,IOST,,<BUFFER,1000,0,0,0>
	.END	START