.MCALL	.MODULE
.MODULE	SLPIO,VERSION=03,COMMENT=<I/O Routines for SLP>,IDENT=NO

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
	.SBTTL	I/O ROUTINES FOR SLP
	.ENABL	LC

; Edit History:
;
; 001	08-Aug-80 02:50 PM Kent, Jeff [240,94]
;	Redefine W level user error traps for slp.
;	(001)
;
;	8-MAR-85	George Thissell
;	Fix device full error message
;
; Jonathan M. Taylor	26-Apr-78
;
; MODIFICATIONS:
;
; X03.01 10-AUG-79	Added code to check for errors in CLOSE and RENAME
;	   -MBG-	due to protected files				;MG01
;
;+

	.SBTTL	Data Areas

;+
;
; Buffer descriptors follow.  Each is actually an EMT argument area for
; .READWs and .WRITWs with prepended pointer and counter.
;
; The layout of each descriptor is:
;
;-

	POINTR	==	-4		; Next byte pointer
	COUNT	==	-2		; bytes left counter
					; channel and function bytes
	BLKNUM	==	 2		; number of next block to read
	BUFADR	==	 4		; buffer address for I/O
	BUFSIZ	==	 6		; word count
					; 1
;Output file (Channel 0)
	.BLKW	2
$OBUF::	11 * 400 + 0
	.BLKW	3
	0

;List file (Channel 1)
	.BLKW	2
$LBUF::	11 * 400 + 1
	.BLKW	3
	0

;Source file (Channel 3)
	.BLKW	2
$SBUF::	10 * 400 + 3
	.BLKW	3
	0

;Command (patch) file (Channel 4)
	.BLKW	2
$CBUF::	10 * 400 + 4
	.BLKW	3
	0

; .RENAME block in case the updated source file has the name of
; a file that already exists.  The RAD50 for the name is filled in
; from a .CSISPC in the main program.

RENBLK:
	4 * 400 + 11			; .RENAME block (uses chan 11)
	$OLDFIL

; .LOOKUP block to see if a file already exists with the same name as
; the updated source file.

LOOBLK:
	1 * 400 + 12			; .LOOKUP block (uses chan 12)
	$OLDFIL
	0

; RAD50 of updated source file name

$OLDFIL::
	.BLKW	4			; RAD50 of updated source file
$BAKFIL::
	.BLKW	3			; RAD50 of updated source file
	.RAD50	'BAK'			; with .BAK extension

EMTBLK::
	.BLKW	10.			;EMT block for programmed requests

DEVADR:	.WORD	0			;Filename address for error messages
;
;These are the RAD50 filenames returned by the .CSISPC in SLP.MAC
;
OUTFIL::.BLKW	5			;Output file name
LSTFIL::.BLKW	10.			;List file name
SRCFIL::.BLKW	4			;Source file name
COMFIL::.BLKW	20.			;Command file name

;Checksum variables

WRDCNT:	.WORD	0			;Word count for $CHKSM

;+
; Modifier table for CRC-16 checksum
;-

CTABLA:	.WORD	0		;First half of table
	.WORD	140301
	.WORD	140601
	.WORD	500
	.WORD	141401
	.WORD	1700
	.WORD	1200
	.WORD	141101
	.WORD	143001
	.WORD	3300
	.WORD	3600
	.WORD	143501
	.WORD	2400
	.WORD	142701
	.WORD	142201
	.WORD	2100

CTABLE:	.WORD	0		;Second half of table
	.WORD	146001
	.WORD	154001
	.WORD	12000
	.WORD	170001
	.WORD	36000
	.WORD	24000
	.WORD	162001
	.WORD	120001
	.WORD	66000
	.WORD	74000
	.WORD	132001
	.WORD	50000
	.WORD	116001
	.WORD	104001
	.WORD	42000

; This is the checksum message. It is printed in CHKPRI

SLPI::	.ASCII	'?SLP-I-'
	.BYTE 	200
NAMBUF::.BLKB	50.			;ASCII filename stored here
CHKMSG::.ASCIZ	/checksum is /
	.EVEN

; TERM holds the character(s) that terminated the line currently in the
; line buffer.  LF, VT, and FF are valid line terminators.  If the char-
; acter before the terminator was a CR, it too is stored in TERM.
; The bytes are stored in such a way that TERM is an ASCIZ string.

TERM:	.BLKW	2

CLCLNU:	.BYTE	15, 12			; two blank lines
CRLFNU:	.BYTE	15, 12, 0		; a blank line

FFNULL:	.BYTE	14, 0			; top of pager

	.EVEN
LNUMB:	.ASCIZ	'X-1/9.' <11>		; line number in ASCII
					; do not change this value!
	.EVEN
	.SBTTL	$GETLN	Get a Line into the Line Buffer

;+
;
; $GETLN gathers an input line from an input files buffer.
; Trailing blanks and tabs will be removed from the line.
;
; INPUTS:
;	R0 -> buffer descriptor for the files buffer
;
; OUTPUTS:
;	R0 -> null byte in the line buffer
;	R1 = horizontal position of the null byte
;
;-

	ERRBYT	= 52			; RT-11 error byte

$GETLN::
	SAVRG				; save regs
	MOV	R0, R5			; R5 -> buffer descriptor
	MOV	COUNT(R5), R0		; R0 = no. bytes left in block buffer
	MOV	POINTR(R5), R1		; R1 -> next byte in block buffer
	MOV	$LNADR, R2		; R2 -> line buffer
5$:	DEC	R0			; one less byte
	BGE	55$			; branch if block buffer not empty
	MOV	R5, R0			; .READW	R5
	EMT	375
	BCS	RERR			; branch if EMT error
	SWAB	R0			; R0 = blocks actually read
	ADD	R0, BLKNUM(R5)		; update block to read number
	SWAB	R0			; R0 = number of words read
	ASL	R0			; R0 = number of bytes read
	DEC	R0			; take one away
	MOV	BUFADR(R5), R1		; R1 -> block buffer
55$:	MOVB	(R1)+, R3		; R3 = next byte in block buffer
	BIC	#177600, R3		; clear garbage bits
	BEQ	5$			; and ignore if null
	CMP	R3, #12			; see if 12, 13, or 14
	BLT	6$
	CMP	R3, #15
	BLT	40$			; and branch if so
6$:	CMP	R2, $LNEND		; compare pointer to end of buffer
	BNE	10$			; branch if not exactly at end
	MOV	R0, -(SP)		; can't lose this
	MOV	$LNADR, R0		; point R0 to line buffer
	CLRB	(R2)			; make ASCIZ
	FATAL	E$LTOL			; warning: Line too long	;001
	MOV	(SP)+, R0		; unlose R0			;**-1
	BR	20$			; continue reading line

10$:	BHI	20$			; branch if past end of buffer
	MOVB	R3, (R2)		; move in the byte
20$:	INC	R2			; bump line buffer pointer
	BR	5$

40$:	MOV	R0, COUNT(R5)		; save state
	MOV	R1, POINTR(R5)
	CMP	R2, $LNEND		; if pointer past end of buffer
	BLOS	41$
	MOV	$LNEND, R2		; set pointer to end of buffer
41$:	MOV	#TERM, R4		; R4 -> terminator storage
	MOV	R3, (R4)+		; save terminator byte
	CLR	(R4)			; clear rest of block
	CMP	R2, $LNADR		; if no characters in the line
	BEQ	50$			; don't check previous byte
	CMPB	-1(R2), #15		; was preceding byte a CR?
	BNE	50$
	SWAB	-(R4)			; if so, save it
	MOVB	-(R2), (R4)		; and delete it from line buffer
50$:	CLRB	(R2)			; set null to flag end of buffer

; Now that the entire line has been read into the line buffer,
; compute column and address of the last non-blank character in the
; buffer.

	MOV	$LNADR, R2		; initialize current end
	CLR	R4
60$:	MOV	R2, R0			; dump into last non-blank end
	MOV	R4, R1
65$:	MOVB	(R2)+, R5		; R5 = next byte
	BEQ	90$			; if null, return non-blank end
	CMPB	#' , R5			; if blank
	BEQ	70$
	CMPB	#11, R5			; or tab
	BNE	80$
	BIC	#7, R4			; update horizontal position
	ADD	#7, R4
70$:	INC	R4			; in R4
	BIT	#NL$ST,$SWTCH		;Are we stripping blanks, tabs	;CG01
	BEQ	65$			;Branch if so... Continue	;CG01
80$:	INC	R4			; otherwise bump column
	BR	60$			; and dump into R0 and R1

90$:	CLRB	(R0)			; put in sentinal byte
RTSPC:	RETURN

RERR:					; .READ error, see wats up
	MOVB	@#ERRBYT, R0		; R0 = RT-11 error code
	BEQ	RTSPC			; if EOF, just return with C set
	CLR	R0			; no optional error message
	ASL	R1			; make index
	ADD	R1, PC			; and dispatch

	0				; EOF already checked
	FATAL	E$HARD			; hardware error
	FATAL	E$BUG			; channel not open (can't happen)
	.SBTTL	$PUTLN	Write the Line Buffer

; $PUTLN is called to output the contents of the line buffer to the
; source and/or the line listing file(s).  The line buffer is
; null terminated so we can find the end.
;
$PUTLN::
	SAVRG				; save registers
	CLR	DEVADR			; clear filename addr for errors
	INC	$LNUMB			; increment line number
	MOV	#$SWTCH, R3		; R3 -> switch word
	MOV	#PUTLN, R5		; R5 -> output routine
	TSTB	@$LNADR			; if line buffer is non-blank
	BEQ	5$
	TSTB	TERM+1			; and CR is not in TERM
	BNE	5$
	SWAB	TERM
	MOVB	#15, TERM		; put one there
	CMPB	TERM+1, #14		; if <CR> <FF>
	BNE	5$
	MOVB	#12, TERM+1		; make <CR><LF><FF> for editors
	MOV	#14, TERM+2
5$:	BIT	#OU$TP, (R3)		; if output file
	BEQ	10$
	MOV	#OUTFIL,DEVADR		; filename for error messages
	MOV	#$OBUF, R0
	MOV	$LNADR, R1		; output the line buffer to it
	CALL	(R5)			; with PUTSTR
	MOV	#TERM, R1		; output the terminator
	CALL	(R5)
10$:	BIT	#LL$ST, (R3)		; if line listing file
	BEQ	90$
	MOV	#LSTFIL,DEVADR		; filename for error messages
	MOV	#$LBUF, R0		; output the line buffer to it
	MOV	#$PLNMB, R4		; R4 -> lines per page counter
	TST	(R4)			; if counter is zero
	BNE	20$
	MOV	#$HEADG, R1		; print top of page heading
	CALL	(R5)
	MOV	#CLCLNU, R1
	CALL	(R5)
20$:	MOV	#LNUMB+4, R0		; R0 -> ASCII line number buffer+4
	MOVB	#' ,(R0)		; put five blanks in line number
	MOV	#"  , -(R0)
	MOV	(R0), -(R0)
	MOV	$LNUMB, R1		; R1 = current line number
	MOV	#$10TAB, R2		; R2 -> powers of ten table
24$:	CMP	R1, (R2)+		; force right justification
	BGE	25$
	INC	R0			; by bumping the buffer pointer
	BR	24$

25$:	CALL	$CBDMG			; convert R1 to (R0)
	MOV	#$LBUF, R0		; restore R0
	MOV	#LNUMB, R1		; print line number
	CALL	(R5)
	MOV	$LNADR, R1		; print the line buffer
	CALL	(R5)
	MOV	#TERM, R1		; and line terminator
	CALL	(R5)
	CMPB	-(R1), #14		; if we just printed a FF
	BEQ	80$			; zero the line per page counter
	BIT	#DB$LE, (R3)		; if double spacing the listing file
	BEQ	30$
	MOV	#CRLFNU, R1		; print a blank line
	CALL	(R5)
	INC	(R4)			; and increment lines per page
30$:	INC	(R4)			; increment lines per page
	CMP	(R4), #56.		; are we at end of page?
	BLT	90$			; if not, just return
	MOV	#FFNULL, R1		; else skip to the top of the next page
	CALL	(R5)
80$:	CLR	(R4)			; zero the lines per page counter
90$:	RETURN				; to the caller
	.SBTTL	PUTLN	Local Output Routine

;+
;
; PUTLN moves an ASCIZ string to a buffer and writes the buffer if
; necessary.
;
; INPUTS:
;	R0 -> buffer descriptor for the buffer
;	R1 -> ASCIZ string to move out
; OUTPUTS:
;	R0 unchanged
;	R1 -> null byte of ASCIZ string
;
;-

PUTLN:
	SAVRG				; save registers
	MOV	R0, R5			; R5 -> buffer descriptor
	MOV	COUNT(R5), R0		; R0 = number of free bytes in buffer
	MOV	POINTR(R5), R2		; R2 -> next free byte in buffer
10$:	MOVB	(R1)+, R3		; R3 = next byte to write
	BEQ	90$			; done when zero
	DEC	R0			; one less byte left in block buffer
	BGE	30$			; branch if not full
	MOV	R5, R0
	EMT	375			; .WRITW	R5
	BCS	WERR			; branch if EMT error
	MOV	R5, R4			; R4 -> descriptor
	TST	(R4)+			; R4 -> BLKNUM
	SWAB	R0			; R0 = number of blocks written
	ADD	R0, (R4)+		; update the block number
	MOV	(R4)+, R2		; R2 -> block buffer
	MOV	(R4), R0		; R0 = buffer size in words
	ASL	R0			; R0 = buffer size in bytes
	DEC	R0			; take one away
30$:	MOVB	R3, (R2)+		; stick the byte into the block buffer
	BR	10$			; and loop 'til null byte

90$:	MOV	R0, COUNT(R5)		; save new state in buffer descriptor
	MOV	R2, POINTR(R5)
	MOV	R5, R0			; restore R0
	DEC	R1			; R1 -> null byte
	RETURN

WERR:					; EMT error
	CLR	R0			; assume no optional error message
	MOVB	@#ERRBYT, R1		; R1 = EMT error
	TSTB	R1			; WEOF message?
	BNE	10$			; if not, branch
	COM	R0			; say filename wanted
	TST	DEVADR			; Contains a zero ?
	BNE	9$			; No, branch
	MOV	#OUTFIL,DEVADR		; Move in RAD50 filename
9$:	MOV	DEVADR,R2		; get filename address
10$:	ASL	R1			; make index
	ADD	R1, PC			; and dispatch

	FATAL	E$WEOF			; end of file on write
	FATAL	E$HARD			; hardware error
	FATAL	E$BUG			; channel not open ("can't" happen)
	.SBTTL	$FLUSH	Flush Output Buffers and Close Files

;+
;
; $FLUSH tests if either of the two output files were specified and
; flushes their buffers if so.
;
; Before closing the updated source file, see if a file existed by the
; same name and , if so, .RENAME it to .BAK.  If the user specified /N,
; delete the .BAK file
;
;-

	.MCALL	.CLOSE, .DELETE

$FLUSH::
	CLR	DEVADR			; clear filename address for errors
	BIT	#OU$TP, (R3)		; if output file specified,
	BEQ	10$
	MOV	#LOOBLK, R0
	EMT	375			; .LOOKUP	#LOOBLK
	BCS	20$			; branch if not found
	MOV	#RENBLK, R0
	EMT	375			; .RENAME	#RENBLK
	BCC	20$			; Rename successful...continue	;MG01+
	CLR	R0			; Get set to get error code
	CLR	R1
	BISB	@#ERRBYT,R1		; Do it...
	CMPB	#1,R1			; FNF error?
	BEQ	3$			; If yes, branch
	CMPB	#3,R1			; RERR error?
	BNE	5$			; If not, branch
3$:	COM	R0			; Say filename wanted
	MOV	#SRCFIL,R2		; Get filename for error message
5$:	ASL	R1
	ADD	R1,PC			; Dispatch to error message
	FATAL	E$BUG			; 'channel not open' ("can't" happen)
	FATAL	E$FNF			; 'file not found'
	FATAL	E$ILRE			; 'illegal rename'
	FATAL	E$RERR			; 'Protected file already...'	;MG01-

20$:	MOV	#$OBUF, R0		; flush and close it
	CALL	FL
	BIT	#DL$BK,$SWTCH		; want .BAK file?
	BEQ	10$			; If yes, branch
	.CLOSE	#11			; Close .BAK file
	.DELETE	#EMTBLK,#11,#$BAKFIL	; Delete it
	BCC	10$			; If successful, branch
	CLR	R0			; No optional error message
	WARN	E$ILDE			; "backup file suppression un"
10$:	BIT	#LL$ST, (R3)		; if listing file specified
	BEQ	RET
	MOV	#$LBUF, R0		; flush and close it
	MOV	#LSTFIL,DEVADR		; filename for error message
FL:
	MOV	R0, R2			; R2 -> EMT block
	MOV	POINTR(R0), R1		; R1 -> first unused byte in buffer
	SUB	BUFADR(R0), R1		; R1 = number of bytes to write
	BEQ	CLOSE			; branch if buffer empty
	CLC
	ROR	R1			; R1 = number of words to write
	BCC	10$			; branch if wasn't odd number of bytes
	CLRB	@POINTR(R0)		; make even by appending a null
	INC	R1
10$:	MOV	R1, BUFSIZ(R0)		; store in EMT argument block
	EMT	375			; .WRITW
	BCS	WERR			; branch if EMT error
CLOSE:
	.CLOSE	(R2)
	BCC	RET			; No problem			;MG01
	MOV	#-1,R0			; Say print a filename
	MOV	DEVADR,R2		; Get filename address
	FATAL	E$CERR			; 'File created:protected...'	;MG01

RET:
	RETURN				; to $FLUSH or its caller

.SBTTL	RDFIL	Read file for checksum
;+
; When the /C option is used, this routine will read the specified file
; and call the routines that compute the checksum
;-

	.MCALL	.READW

RDFIL::
	CLR	CKSUM			;Clear previous checksum
	CLR	R1			;Clear CRC storage register
	CLR	R2			;Clear block number
10$:	.READW	#EMTBLK,CHAN,BUFSTR,WCNT,R2
	BCS	20$			;If error, branch
	MOV	R0,R3			;Save # of words read
	SWAB	R0			;R0 = # of blocks read
	ADD	R0,R2			;Update block to read
	MOV	R2,-(SP)		;Save new block number
	CALL	$CHKSM			;Compute checksum
	MOV	(SP)+,R2		;Get block to read
	BR	10$			;Continue until EOF

20$:	MOVB	@#ERRBYT,R3		;Get error byte for .READW
	BEQ	40$			;If EOF, normal return
	CLR	R0			;No optional error message
	CMP	R3,#1			;Hard error?
	BNE	30$			;If not, branch
	FATAL	E$HARD			;Hardware error

30$:	FATAL	E$BUG			;Open channel

40$:	MOV	R1,CKSUM		;Save checksum
	RETURN
.SBTTL	$CHKSM	Set up to compute checksum
;+
; INPUTS:
;	R3 = # of words to put into checksum this pass
;	BUFADR = Buffer start address
; OUTPUTS:
;	CKSUM = Checksum at the end of this pass
;-
$CHKSM::
;	SAVRG				;Save registers
	MOV	R3,WRDCNT		;Save word count
	MOV	BUFSTR,R2		;Save buffer start
10$:	MOV	(R2)+,R0		;Get word for checksum
	MOV	R2,-(SP)		;Save next address on stack
	CALL	CHKSM			;Compute checksum
	MOV	(SP)+,R2		;Restore next address
	DEC	WRDCNT			;Dec word count
	BGT	10$			;Keep going
	RETURN
	.SBTTL	CHKSM - CRC-16 checksum routine

;+
; CHKSM
; This routine generates the checksum.
;
;Input:	R0= Word to check
;	R1= CRC storage register
;
; CALL	CHKSM		;Update the checksum value
;
;Output:R1= New or updated CRC register
;	R0,R2,R3,R4 are destroyed
;-

CHKSM::	MOV	R0,-(SP)	;Save the value on the stack for further oper.
	CALL	CRC16		;Do checksum
	MOV	R4,R1		;New CRC
	SWAB	@SP		;Swap bytes
	MOV	(SP)+,R0	;Prepare to
	CALL	CRC16		;Do checksum
	MOV	R4,R1		;New CRC
	RETURN

CRC16::	BIC	#177400,R0	;Clear the high byte
	MOV	R1,R3		;Set up for XOR
	MOV	R0,R4		;Set up for XOR, results return in R4
	CALL	XOR		;EXCLUSIVE OR byte with old CRC
	MOV	R4,R0		;Put results in R0
	MOV	R0,R2		;Save a copy of result
	BIC	#177760,R0	;Extract low 4 bits
	ASL	R0		;Byte address, word index
	ADD	PC,R0		;Set up PIC address
	MOV	CTABLA-.(R0),R0	;Get first modifier word
	BIC	#177417,R2	;Now extract high 4 bits
	ASR	R2		;Set up to enter second half
	ASR	R2		;Again byte address to
	ASR	R2		;word index
	ADD	PC,R2		;Set up pic address
	MOV	CTABLE-.(R2),R2	;Get second modifier word
	MOV	R2,R3		;Set up for XOR
	MOV	R0,R4		;Set up for XOR, results return in R4
	CALL	XOR		;EXCLUSIVE OR modifier values
	CLRB	R1		;Clear low byte or old CRC
	SWAB	R1		;Now work on upper byte
	MOV	R4,R3		;Set up previous return from XOR oper. for XOR
	MOV	R1,R4		;Set up for XOR, results return in R4
XOR:	MOV	R3,-(SP)	;Set for bit clear
	BIC	R4,R3		;Clear all set bits
	BIC	(SP)+,R4	;Clear set bits
	BIS	R3,R4		;Now combine all bits
	RETURN
	.SBTTL	CHKPRI	Print checksum message
;+
; This routine will convert the checksum into ASCII and print it
;
; INPUTS: R0 -> address of RAD50 filename
;
; OUTPUTS: CKSUM = checksum value to be printed
;-

	.MCALL	.PRINT


CHKPRI::
	MOV	#NAMBUF,R1		; Get buffer for ASCII output
	CALL	$FNASC			; Convert RAD50 filename to ASCII
	MOVB	#40,(R1)+		; Put in a blank
	MOV	#CHKMSG,R0		; Put "checksum is"
10$:	MOVB	(R0)+,(R1)+		; into msg
	TSTB	@R0			; At end?
	BNE	10$			; If not, continue
	MOV	R1,R2			; Convert
	MOV	CKSUM,R1		; checksum 
	CALL	OCTOUT			; to ASCII
	CLRB	@R2			; Put in terminator
	.PRINT	#SLPI			; Print "SLP-I-"
	.PRINT	#NAMBUF			; Print rest of message
	RETURN

.SBTTL	OCTOUT	Convert checksum from octal to ASCII
;+
; INPUTS: R1 = Checksum
; 	  R2 = address of storage area for ASCII
; OUTPUTS:
;	  R2 -> ASCII checksum
;-
OCTOUT::
	MOV	R1,-(SP)	;Get the low order word
	MOV	#30,R0		;'0/2 - for bit 15
	SEC			;Set guard bit to flag finish
8$:	ROL	R1		;get next bit from output word
	ROLB	R0		;Shift into ASCII byte
	MOVB	R0,(R2)+	;Store the character in the print buffer
	MOV	#206,R0		;'0/10+100
10$:	ASL	R1		;Get next bit
	BEQ	11$		;Equal - done
	ROLB	R0		;Shift bit into ASCII byte
	BCS	10$		;Branch to get second bit
	BR	8$		;Branch to get third bit and print

11$:	CLR	R0		;Initialize R0
	TST	(SP)+		;Clean up stack
	RETURN

	.END