.TITLE	RP_PUNCH	PUNCH CARDS
	.IDENT	/01/
; AUTHOR:	KUNZE
;		3/88
;
; FUNCTION:	Read records from input file, write to cardpunch
;		with only CR, no LF
;
; ON ENTRY:	$ DEFINE RP_READER_PUNCH_PORT LTAnnnn:	! output
;		$ DEFINE RP_READER_PUNCH_FILE filespec	! input
;
; MODIFICATIONS:
;

; Constant data section
	.PSECT	CONST,NOEXE,RD,NOWRT

BUF_SIZE = 512		; size of input buffer
P4ARG:	.LONG	^X2B	; specify FORTRAN overprint control on qio
PUNCH_MSG:
	.ASCID	/PUNCHING CARDS.../	; msg displayed while running

; Read/write data section
	.PSECT	RWDATA,NOEXE,RD,WRT,LONG

; file and record acces blocks used by RMS
IN_FAB:
	$FAB	FNM = <RP_READER_PUNCH_FILE>, - ; filename (logical)
		RFM = VAR, -		; record format
		FAC = <GET>		; we can get records
IN_RAB:
	$RAB  	FAB = IN_FAB, -
		USZ = BUF_SIZE, -	; buffer size
		UBF = REC_BUFF		; address of input buffer

CRNAME:	.ASCID	/RP_READER_PUNCH_PORT/	; terminal name descriptor (logical)
CRDESC:				; descriptor for physical name
	.LONG	BUF_SIZE 	; length of physical name buffer
	.ADDRESS -		; buffer address
		REC_BUFF
CRCHAN:	.BLKW	1		; channel number assigned here
CRIOSB:	.BLKW	1		; begin io status block
CRIOLEN:
	.BLKW	1		; length
CRIOTERM:
	.BLKW	1		; terminating character
	.BLKW	1		; size of terminator (should be 1)

REC_BUFF:
	.BLKB	BUF_SIZE	; record buffer

CLEANUP_BLK:		; exit handler control block
	.LONG	0		; system pointer
	.LONG	CLEANUP		;address of exit handler
	.LONG	1		; argument count
	.LONG	STATUS		; status code destination
STATUS:	.BLKL	1		; status code from $EXIT

;----------------------------------------------------------------------
; Main program section
	.PSECT	CODE,EXE,RD,NOWRT

	.ENTRY	RP_PUNCH, ^M<>

; display a msg so user knows we're running
	PUSHAB	PUNCH_MSG
	CALLS	#1, G^LIB$PUT_OUTPUT

	BSBW	OPEN_PORT	; open the reader/punch port
	$DCLEXH_S CLEANUP_BLK	; exit handler to reset characteristics
	BSBW	OPEN_FILE	; open input file
	BSBW	TRANSFER	; punch cards

EXIT:
	MOVL	#1, R0		; indicate normal exit
	RET			; return to system

;----------------------------------------------------------------------
CLEANUP:	; exit handling routine executed on image exit
			; to deallocate port

	.WORD		; entry mask
	$CANCEL_S -
		CHAN = CRCHAN	;cancel any i/o on queue
	$DASSGN_S -			;deassign the channel
		CHAN = CRCHAN
	$DALLOC_S -			;deallocate the device
		DEVNAM = CRDESC

	RET
	
;----------------------------------------------------------------------
OPEN_PORT:
	$ALLOC_S -		; allocate the card reader CRPORT
		DEVNAM = CRNAME, -
		PHYLEN = CRDESC, -
		PHYBUF = CRDESC
	BSBW	ERROR

	$ASSIGN_S -		; assign card reader channel
		DEVNAM=CRDESC,-
		CHAN=CRCHAN
	BSBW	ERROR
	RSB

;----------------------------------------------------------------------
; RMS file and record error reporting and exiting routines
RMS_ERR:
	MOVAL	IN_FAB,R5	; check for file related error
	CMPL	R5,R6
	BEQL	F_ERR
	MOVAL	IN_RAB,R5	; check for record related error
	CMPL	R5,R6
	BEQL	R_ERR

F_ERR:	PUSHL	FAB$L_STV(R6)
	PUSHL	FAB$L_STS(R6)
	CALLS	#2, G^LIB$SIGNAL	; display the error message
	BRW	EXIT	
R_ERR:	PUSHL	RAB$L_STV(R6)
	PUSHL	RAB$L_STS(R6)
	CALLS	#2, G^LIB$SIGNAL	; display the error message
	$CLOSE	FAB=IN_FAB
	BRW	EXIT

;----------------------------------------------------------------------
OPEN_FILE:
	$OPEN	FAB=IN_FAB		; open input file
	BLBS	R0,OKFAB		; continue if no errors
	MOVAL	IN_FAB,R6		; else Quit, 
	BRW	RMS_ERR			;	signalling fab rms_err
OKFAB:
	$CONNECT RAB=IN_RAB		; talk to RMS file
	BLBS	R0,OKRAB		; continue if no errors
	MOVAL	IN_RAB,R6		; else quit,
	BRW	RMS_ERR			;	signalling rab rms_err
OKRAB:
	RSB

;----------------------------------------------------------------------
TRANSFER:		; read records and punch cards
GET_RECORD:
	$GET	RAB = IN_RAB		; read record from input file
	CMPL	IN_RAB + RAB$L_STS, #RMS$_EOF ; end of file?
	BNEQ	10$
	BRW	CLOSE_FILE		; if end of file, we're done
10$:
	BSBW	ERROR			; check for any other errors

	MOVZWL	IN_RAB + RAB$W_RSZ, R10	; check size of input record
	CMPW	#80, R10		; if more than 80
 	BGEQ	20$
	MOVZWL	#80, R10		; 	truncate to 80
20$:

	$QIOW_S	CHAN = CRCHAN,-		; connect remote port
		FUNC = #IO$_WRITEVBLK,-	; we're going to write
		P1 = REC_BUFF, -	; record to punch
		P2 = R10, -		; length ( <= 80)
		P4 = P4ARG, -		; adds carriage return only
  		IOSB = CRIOSB
	BSBW	ERROR

	BRB	GET_RECORD

CLOSE_FILE:
	$CLOSE	FAB = IN_FAB		; close file

	RSB

;----------------------------------------------------------------------
ERROR:
	BLBS	R0,10$	; if R0 not set, then no error
	$EXIT_S	R0	; exit with error message if error encountered
10$:	RSB		; else return

;----------------------------------------------------------------------
	.END RP_PUNCH