;	SNDFIL sends files to GETFIL
;
;	main-claim-to-fame is compatibility with Larry White's
;	BLKSND/BLKRCV programs on the WD16 based systems.
;
;       Copyright [c] Noel Alaska Systems Technology, 1983.
 
 
VMAJOR	=	1.			; version equates
VMINOR	=	0.
VSUB	=	0.
VEDIT	=	16.			; CHANGE EACH EDIT <-----------
VWHO	=	0.
 
        SEARCH  SYS                     ; AMOS librarys
        SEARCH  SYSSYM
	SEARCH	TRM
	SEARCH	MFN			; My library
 
        DSECT
        .=0
THETRM:	BLKL	1			; addr comm. terminal
XTDV:	BLKL	1			; orig term driver
BUFADR:	BLKL	1			; address of buffer
BUFSIZ:	BLKL	1			; size of buffer
FILSIZ:	BLKL	1			; # blocks in file : # sent so far
FILSI2:	BLKL	1			; used to decide when to dot
ACKCNT:	BLKL	1			; # acks/naks/whatever so far
CKSUM:	BLKW	1			; checksum
FDDB:	BLKB	D.DDB			; input file DDB
TDDB:	BLKB	D.DDB			; terminal DDB
CYCLIC:	BLKB	1			; block cyclic #
ACKBUF:	BLKB	6			; response (ack/nak) buffer
DONSWC:	BLKB	1			; flag set by done before abend
TRMSWC:	BLKB	1			; flag - using attached terminal
ACKTIM:	BLKB	1			; timeout count for ACK
ACKTRY:	BLKB	1			; retry count for ACK
BUFTYP:	BLKB	1			; 2 = unchanged : 5 = translated
BUFFER:	BLKB	512.			; large buffer
        EVEN
IMPURE  =       .
        .=0
        PSECT

BEGIN:  PHDR    -1,-1,PH$REE!PH$REU
        GETIMP  IMPURE,A5               ; get memory
 
	JOBIDX	A0
	MOV	JOBTRM(A0),THETRM(A5)	; presume attached terminal
	SETB	TRMSWC(A5) 
 
	BYP 
	LIN 
	JEQ	USAGE 
	CMMB	(A2)+,#'- 		; request for attached terminal?
	BEQ	ATTCHD			;   YES
	DEC	A2			; put terminal name into DDB
	FSPEC	TDDB(A5),TRM 
	LEA	A1,TDDB+D.FIL(A5) 
	CALL	FNDTRM 			; go find terminal
	MOV	A3,THETRM(A5) 		; save TRMDEF addr
	JEQ	TNF 			; quit if not found
	TST	T.JLK(A3) 		; is terminal attached?
	JNE	TND 			;   YES - error
	CLRB	TRMSWC(A5) 		;   NO  - not not using attached
 
ATTCHD:	BYP 
	LIN
	JEQ	FNAME 
	FSPEC	FDDB(A5),TXT 		; put file name into DDB
	INIT	FDDB(A5) 		; get buffer
	LOOKUP	FDDB(A5) 		; see if it exists
	JNE	FNF 			;   NO  - error

	MOVW	#[TRM],TDDB+D.DEV(A5) 	; setup device/drive for TRM:
	CLRW	TDDB+D.DRV(A5) 
	INIT	TDDB(A5) 		; get buffer
	OPENO 	TDDB(A5) 		; alpha never did impl. TTYOUT

	TSTW	FDDB+D.WRK+6(A5)	; sequential file?
	BPL	NOTRND			;   YES
	TSTB	TRMSWC(A5) 
	JNE	DONE
	TYPECR	<%Will send null file - RANDOM files not supported>
	JMP	DONE

NOTRND:	MOV	FDDB+D.WRK(A5),FILSIZ(A5) ; save # blocks
	OPENI 	FDDB(A5) 		; open file
 
	MOV	THETRM(A5),A4 		
	TSTB	TRMSWC(A5)		; using attached terminal?
	JNE	2$ 			;   YES
;	CRT	255.,0			; put up logo
	TYPESP	<SNDFIL Version>
	VCVT	BEGIN+2,OT$TRM
	TYPECR	< [for AM-1000]>
	TYPESP	<File> 
	PFILE	FDDB(A5) 
	TYPE	< is> 
	MOV	FILSIZ(A5),D1 
	DCVT	0,62 
	TYPE	<block> 
	DEC	D1 
	BEQ	1$
	TYPE	<s> 
1$:	TYPECR	< long.> 
	BR	DOIT 
 
2$:	SLEEP	#200000.		; sleep 20 seconds if attached
 
DOIT:	MOVB	#'@,CYCLIC(A5) 		; init cyclic block #
	BIS	#T$IMI!T$ECS,@A4 	; setup term status bits
	MOV	T.TDV(A4),XTDV(A5)	; save original TDV
	MOV	TRMTDC,A0		; and switch to PSEUDO.TDV
	ADD	#10,A0
	MOV	A0,T.TDV(A4)
	CLR	FILSIZ(A5) 		; init block number
	CLR	FILSI2(A5)
 
LOOP:	CALL	GETFIL 			; get some data
	JLO	DONE 			;   EOF
	CALL	DECIDE 			; unpack buffer if needed
	INCB	CYCLIC(A5) 		; incr cyclic number
	ANDB	#^B1001111,CYCLIC(A5) 
	MOVB	#10.,ACKTRY(A5) 	; setup # retries allowed
	TSTB	TRMSWC(A5) 		; using attached terminal?
	BNE	1$ 			;   YES - skip dot
	CMM	FILSIZ(A5),FILSI2(A5)	; new disk block?
	BEQ	1$			;   NO  - skip dot
	MOV	FILSIZ(A5),FILSI2(A5)	; update disk block
	TYPE	<.> 			; show not dead
1$:	CLR	T.ICC(A4) 		; clear any waiting input
	CALL	SENDIT 			; send the block
2$:	BIT	#T$OIP,@A4 		; wait for the output to finish
	BEQ	3$ 
	SLEEP	#1500.
	CTRLC	CCWOC 			; allow ^C while waiting
	BR	2$ 
3$:	MOVB	#50.,ACKTIM(A5) 	; allow up to 5 seconds for ACK
	CLR	ACKCNT(A5) 
4$:	DECB	ACKTIM(A5) 
	BLT	5$ 
	SLEEP	#1000.
	CTRLC	CCWR 			; allow ^C while waiting
	CALL	GETRSP 			; any response yet?
	BLO	4$ 			;   NO
	CMPB	D1,#6 			; is response ACK?
	BEQ	LOOP 			;   YES - go do next block
	CMPB	D1,#7 			; is response BELL?
	BEQ	6$ 			;   YES - remote not talking 
5$:	DECB	ACKTRY(A5) 		; assume NAK
	JLT	BLKBAD 			; if 10 retries so far - abort
	TSTB	TRMSWC(A5) 
	BNE	1$ 
	TYPE	<R> 
	BR	1$ 
6$:	MOV	#100.,D0 		; 5 seconds to clear the
7$:	CLR	T.ICC(A4) 		; bells from our heads...
	SLEEP	#500.
	SOB	D0,7$ 
	JMP	RMTBAD 			; then abort
 
DONE:	LEA	A2,EOTS 		; send EOT so other end knows
	MOV	A2,TDDB+D.BUF(A5)
	MOV	#5,TDDB+D.SIZ(A5)
	OUTPUT	TDDB(A5) 
	SETB	DONSWC(A5)		; set normal end flag
	TSTB	TRMSWC(A5) 		; using attached terminal?
	BNE	ABEND 			;   YES - be quiet
	CRLF 				;   NO  - note end
	TYPECR	<Transmission Complete> 
 
ABEND:	BITB	#D$OPNI,FDDB+D.OPN(A5)	; check to be sure file opened
	BEQ	1$
	CLOSE	FDDB(A5) 		; close if it was opened
1$:	CLOSE	TDDB(A5) 		; close term
	MOV	THETRM(A5),A2
2$:	BITW	#T$OIP,@A2		; wait for output to clear
	BNE	2$
	TST	T.OQX(A2)
	BNE	2$
	TST	XTDV(A5)		; restore original TDV
	BEQ	3$
	MOV	XTDV(A5),T.TDV(A4)
3$:	TSTB	DONSWC(A5)		; did we come thru 'DONE'?
	BNE	4$			;   YES - just exit
	TSTB	TRMSWC(A5)		; using attached terminal?
	BNE	4$			;   YES - be quiet
	TYPECR	<!!!ABEND!!!>		;   NO  - 'search for' message
4$:	EXIT 
 
GETFIL:	MOV	FDDB+D.SIZ(A5),D1 	; any data left?
	MOV	FDDB+D.IDX(A5),D2 
	SUB	D2,D1 
	BLOS	2$ 			;   NO  - go read more
	ADD	FDDB+D.BUF(A5),D2 
	MOV	D2,BUFADR(A5) 		; note address of the data
	CMP	D1,#256.		; is there > 256 bytes of it?
	BLE	1$			;   NO
	MOV	#256.,D1 		;   YES - use only first 256
1$:	MOV	D1,BUFSIZ(A5) 		; note amount of data
	ADD	D1,FDDB+D.IDX(A5) 	; update DDB too
	LCC	#0 			; say not EOF
	RTN 
2$:	INPUT	FDDB(A5) 		; read new block
	TST	FDDB+D.SIZ(A5) 		; got any?
	BNE	3$ 			;   YES
	LCC	#1			;   NO  - signal EOF
	RTN 
3$:	INC	FILSIZ(A5)		; update block #
	BR	GETFIL			; go normal process

; routine decides whether or not buffer must be sent unpacked
DECIDE:	MOV	BUFADR(A5),A2 
	MOV	BUFSIZ(A5),D3 
1$:	CMMB	@A2,#1			; must unpack if ^A
	BEQ	2$ 
	CMMB	@A2,#3			; must unpack if ^C
	BEQ	2$
	TSTB	(A2)+ 			; must unpack if NULL 
	BLE	2$ 			; or parity bit already set
	SOB	D3,1$ 
	MOVB	#2,BUFTYP(A5)		; leave as-is if no reason to unpack
	RTN 
2$:	MOVB	#5,BUFTYP(A5)		; note unpacked format
	CALL	TRNBUF			; go unpack the buffer
	RTN 
 
; routine to send a block of data to remote
SENDIT:	MOV	TDDB+D.BUF(A5),A2 
	MOVB	#^H081,(A2)+ 		; send a '1'
	MOVB	CYCLIC(A5),(A2)+ 	; send block cyclic number
	MOV	BUFSIZ(A5),D1 		; get block size into D1
	MOV	D1,D0 			;		  and D0
	AND	#^H01F,D0 		; select low portion  D0
	ASRW	D1,#5 			; select hi  portion  D1
	AND	#^H01F,D1 
	BIS	#^H0C0,D0 		; turn on parity and bias
	BIS	#^H0C0,D1 
	MOVB	D0,(A2)+ 		; send low order
	MOVB	D1,(A2)+ 		; send hi  order of size
	MOVB	BUFTYP(A5),(A2)+ 	; send buffer type
	MOV	#5,TDDB+D.SIZ(A5) 	; tell driver to send 5 bytes
	SUB	#4,A2 			; point to buffer cyclic number
	MOV	#4,D3 			; say 4 bytes to checksum
	CLRW	CKSUM(A5) 		; preclear checksum
	CALL	CSUM1 			; checksum the header
	OUTPUT	TDDB(A5) 		; send header
	PUSH	TDDB+D.BUF(A5) 		; save addr real buffer
	MOV	BUFADR(A5),A2 		; point to whatever buffer being used
	MOV	A2,TDDB+D.BUF(A5) 	; tell driver to use it
	MOV	BUFSIZ(A5),D3 		; pick up buffer size
	MOV	D3,TDDB+D.SIZ(A5) 	; tell driver about that too
	CALL	CSUM1 			; checksum the buffer
	OUTPUT	TDDB(A5) 		; send the buffer
	POP	TDDB+D.BUF(A5) 		; recover the real buffer addr.
	MOVB	#^H017,D1		; include ETB in checksum
	CALL	CSUM2 
	MOV	TDDB+D.BUF(A5),A2 	; send ETB
	MOVB	#^H097,(A2)+ 
	CLR	D1
	MOVW	CKSUM(A5),D1 		
	MOV	D1,D0 
	AND	#^H03F,D0 		; send low order 6 bits of checksum
	BIS	#^H0C0,D0 
	MOVB	D0,(A2)+ 
	MOV	D1,D0 
	ROXRW	D0,#6 			; send middle 6 bits of checksum
	AND	#^H03F,D0 
	BIS	#^H0C0,D0 
	MOVB	D0,(A2)+ 
	ROXLW	D1,#5 			; send high order 4 bits of checksum
	AND	#^H0F,D1 
	BIS	#^H0C0,D1 
	MOVB	D1,(A2)+ 
	MOV	#4,TDDB+D.SIZ(A5) 	; tell driver to send 4 bytes
	OUTPUT	TDDB(A5) 		; send em
	RTN 

GETRSP:	CALL	GETTRM 			; return char if any
	BEQ	2$ 			;  NONE
	LEA	A2,ACKBUF(A5) 		; put char into buffer
	ADD	ACKCNT(A5),A2 
	MOVB	D1,@A2 
	INC	ACKCNT(A5) 
	CMM	ACKCNT(A5),#5 		; 5 yet?
	BLT	2$ 			;  NO
	LEA	A2,ACKBUF(A5) 		; point to buffer
	MOV	#4,D0 
	MOVB	(A2)+,D1 
1$:	CMPB	D1,(A2)+ 		; verify all 5 the same
	BNE	3$ 			; NAK if not
	SOB	D0,1$ 
	LCC	#0 
	RTN 
2$:	LCC	#1 			; say no response yet
	RTN 
3$:	MOVB	#^H015,D1		; say NAK response
	LCC	#0 
	RTN 
 
; routine finds the TRMDEF associated with a terminal name
FNDTRM:	LEA	A3,TRMDFC 
1$:	MOV	@A3,D7 			; point to next on chain
	MOV	D7,A3			; set cond code
	BEQ	2$			; quit if end of chain
	CMM	@A1,4(A3) 		; is this the right one?
	BNE	1$ 			;   NO
	ADD	#10,A3 			; point to TRMDEF proper
2$:	RTN 
 
; routine gets one (or none) chars from the terminal
GETTRM:	SAVE	A5
	MOV	A4,A5			; TTYIN requires A5 --> TRMDEF
	TTYIN				; get a char
	AND	#177,D1			; anything gotten?
	REST	A5
	RTN

; routine runs buffer to compute checksum (and sets parity bits)
CSUM1:	PUSH	D3 
	BEQ	2$ 
1$:	MOVB	@A2,D1 			; get a byte
	CALL	CSUM2 			; add to checksum
	BISB	#200,(A2)+ 		; set parity bit
	SOB	D3,1$ 			; loop till done
2$:	POP	D3 
	RTN 

; routine sums each char into chechsum
CSUM2:	AND	#177,D1 		; remove parity
	RORW	D1,#8.			; put char in top half of word
	CLR	D7
	MOVW	CKSUM(A5),D7 
	XORW	D7,D1			; lay the checksum down on top
	MOV	#8.,D0 
1$:	ASLW	D1 			; shift left
	BHIS	2$ 			; if nothing wrapped
	XORW	#^H0C003,D1 		; take care of wrap
2$:	SOB	D0,1$ 			; do it 8 times
	MOVW	D1,CKSUM(A5) 		; that's the new checksum
	RTN 

; Routine unpacks the buffer.
; Buffer is unpacked so that no character in it is < space or > rubout,
; which is to say that there are only 6 significant bits in any character.
; The extra bits are stored in extra characters.  Three characters generate
; six extra bits which go into the extra character.  So the format is:
;   3 characters of data
;   1 character  of extra bits for the preceeding 3 characters
; If the block length is not divisible by 3, the final character will be
; the extra bits for the preceeding 1 or 2 characters.
TRNBUF:	PUSH	A4 
	MOV	BUFADR(A5),A2 		; point to wherever data is now	
	MOV	BUFSIZ(A5),D3 		; get its size
	LEA	A4,BUFFER(A5) 		; point to unpack area
1$:	CLR	D1 			; preclear 'extra bits'
	CALL	TRNB2 			; unpack one char
	BLE	2$ 			; if that's all - stop
	CALL	TRNB2 			; unpack another char
	BLE	3$ 			; if that's all - stop
	CALL	TRNB2 			; unpack another char
	BLE	4$ 			; if that's all - stop
	ROXRW	D1,#2			; adjust extra bits byte
	ADD	#40,D1 
	MOVB	D1,(A4)+ 		; save extra bits byte
	BR	1$ 			; go for whole buffer

2$:	ROXRW	D1,#2			; one   char  of extra bits
3$:	ROXRW	D1,#2			; two   chars of extra bits
4$:	ROXRW	D1,#2			; three chars of extra bots
	ADD	#40,D1 			; adjust extra bits
	MOVB	D1,(A4)+ 		; save extra bits byte
	LEA	A3,BUFFER(A5)		; point to where we started
	SUB	A3,A4 			; compute size
	MOV	A3,BUFADR(A5) 		; update where data actually is
	MOV	A4,BUFSIZ(A5) 		; update size
	POP	A4 
	RTN 

TRNB2:	MOVB	(A2)+,D0 		; get a byte of data
	AND	#377,D0 		; remove possible hi-order bits
	ROXRW	D0,#1			; adjust this  byte
	ROXRB	D1,#1			; adjust extra bits
	ROXRW	D0,#1
	ROXRB	D1,#1
	ADD	#40,D0			; put in bias
	MOVB	D0,(A4)+		; save data byte
	DEC	D3 			; reduce # bytes to go
	RTN 

TNF:	TYPECR	<?Terminal not found> 
	JMP	USAGE
FNAME:	TYPECR	<?Second parameter must be a file name> 
	BR	USAGE 
FNF:	TYPECR	<?Input file does not exist> 
USAGE:	TYPECR	< usage:  SNDFIL  Terminal  filename> 
	EXIT 
TND:	TYPECR	<?Terminal must be detached from its job> 
	EXIT 

CCWR:	CRLF 
	TYPECR	<^C while waiting for reply> 
	JMP	ABEND 
CCWOC:	CRLF 
	TYPECR	<^C while waiting for output to complete> 
	JMP	ABEND 
BLKBAD:	CRLF 
	TYPECR	<Block transfer failed 10 times.> 
	JMP	ABEND 
RMTBAD:	CRLF 
	TYPECR	<Remote System is not receiving properly> 
	JMP	ABEND 
 
	RADIX	16.
ACKS:	BYTE	06,06,06,06,06,0
NAKS:	BYTE	15,15,15,15,15,0
EOTS:	BYTE	84,84,84,84,84,0
 
	EVEN 
	END