; XMODEM-SENECA v2.10
;
	extrn	freesp,padc,ma3dc
	public	delay,optsav,print
	cseg
;
VERSION:EQU	2
MODLEV:	EQU	1
;
NO:	EQU	0
YES:	EQU	0FFH
;
; Define ASCII characters used
;
ACK:	EQU	06H		;acknowledge
CAN:	EQU	18H		;control-x for cancel
CR:	EQU	0DH		;carriage return
CRC:	EQU	'C'             ;crc request character
EOF:	EQU	1AH		;^Z for end of file
EOT:	EQU	04H		;end of transmission
LF:	EQU	0AH		;linefeed
NAK:	EQU	15H		;neg acknowledge
SOH:	EQU	01H		;start of header
;
; Incidental equates
;
;ACL:	EQU	3EH	;access level storage
;xmup	equ	35h
;xmdn	equ	36h
;maxdn	equ	5	;max downloads allowed (0=unlimited)
;MAXS0:	EQU	80	;max # of sectors for ACL=0
MHZ:	EQU	4	;clock speed, use integer (2,4,5,8, etc.)
NOCOMR:	EQU	YES	;yes, change .COM to .OBJ on receive
NOCOMS:	EQU	YES	;yes, .COM files not sent
NOLBS:	EQU	YES	;yes, .??# files not sent
NOSYS:	EQU	YES	;yes, no $SYS files sent or reported
;
; Some modems will either go onhook immediately after carrier loss
; or can be set to lower values. A good value with the Smartmodem
; is 5 seconds, since it catches all "call forwarding" breaks.
; Not all is lost after timeout in XMODEM; BYE will still wait
; some more, but the chance of someone slipping in is less now.
;
TIMOUT:	EQU	1	;seconds to abort after carrier loss
;
;=======================================================================
;
; Type of CP/M - standard starting at 0100H or alterate starting address
;
STDCPM:	EQU	YES	;yes, if standard CP/M, no if not
;
;=======================================================================
;
; Allows drive/user area to be specified for downloading.  If using ZCPR
; set USEMAX 'YES'.  Then the answers to MAXDRV and MAXUSR are superflu-
; ous.
;
USEMAX:	EQU	NO	;yes if using ZCPR to set DRIVMAX & USRMAX values
			;no to use MAXDRV and MAXUSR specified below
DRIVMAX:EQU	03DH	;location of MAXDRIV byte
USRMAX:	EQU	03FH	;location of MAXUSER byte
;
; If USEMAX above is YES for automatic ZCPR setting, the following two
; are not used. 
;
MAXDRV:	EQU	2	;number of disk drives used
MAXUSR:	EQU	30	;maximum 'SEND' user allowed    
;
;=======================================================================
;
; Length of external patch program.  If over 128 bytes, get/set size
;
LARGEIO:EQU	NO	;yes, if modem patch area over 128 bytes
LARSIZE:EQU	0	;if 'LARGEIO' set patch area size here
;
;=======================================================================
;
; Type of modem being used - an external patch file needed in any event.
;
ALTOS:	EQU	NO	;yes, if altos
EXTMOD:	EQU	YES	;yes, if external modem
INTER3:	EQU	NO	;yes, if compupro interfacer3/4 card
;
;=======================================================================
;
; Allows uploading to be done on a specified driver and user area so all
; viewers (indluding the SYSOP) can readily find the latest entries.
;
SETAREA:EQU	YES	;yes, if using designated area to receive files
DRV:	EQU	'A'     ;drive to receive file on
USR:	EQU	5	;user area to receive file in
;
;=======================================================================
;
; Selects the drive/user area for uploading private files for the SYSOP.
; This permits experimental files, replacement files and proprietary
; programs to be sent to the sysop.
;
PRDRV:	EQU	'A'     ;private drive for SYSOP to receive file
PRUSR:	EQU	1	;private user area for SYSOP to receive file
;
;=======================================================================
;
; Selects the drive/user area for downloading private files for SYSOP
; use.	This permits him to put a special file in this area, then leave
; a private note to that person mentioning the name of the file and its
; location.  Although anybody could download that program, they don't
; know what (if any) files are there.  A high degree of security exists,
; while the sysop still has the ability to make special files available.
; Thus any person can be a temporary "privileged user".
;
SPLDRV: EQU     'A'     ;special drive area for downloading SYSOP files
SPLUSR:	EQU	30	;special user area for downloading SYSOP files	
;
;=======================================================================
;
; File transfer logging options
;
LGCL:	EQU	YES	;yes, logs XMODEM transfers
LOGUSR:	EQU	0	;user area to put 'LOG.SYS' file
LOGDRV:	EQU	'A'     ;drive to place 'LOG.SYS' file
LASTUSR:EQU	0	;user area of 'LASTCALR' file, if 'LGCL' yes
;
;=======================================================================
;
; The receiving station sends an 'ACK' for each valid sector received.
; It sends a 'NAK' for each sector incorrectly received.  In poor con-
; ditions either may be garbled.  Waiting for a valid 'NAK' can slow
; things down somewhat, giving more time for the interference to quit.
;
ACKNAK:	EQU	NO	;yes resends a record after any non-ACK
			;no requires a valid NAK to resend a record
;
	IF	STDCPM
BASE:	EQU	0		;cp/m base address
	ENDIF
;
	IF	NOT STDCPM
BASE:	EQU	4200H		;alternate cp/m base address
	ENDIF
;
;-----------------------------------------------------------------------
;
;			PROGRAM STARTS HERE
;
;-----------------------------------------------------------------------
;
;
	JMP	BEGIN
;
;-----------------------------------------------------------------------
;
; This is the I/O patch area.  Assemble the appropriate I/O patch file
; for your modem, then integrate it into this program via DDT (or SID).
;
; Initially, all jumps are to zero, which will cause an unpatched
; XMODEM to simply execute a warm boot.  All routines must end with RET.
;
CONOUT:	JMP	0		;see 'CONOUT' discussion above
MINIT:	JMP	0		;initialization routine (if needed)
UNINIT:	JMP	0		;undo whatever minit did (or return)
SENDR:	JMP	0		;send character (via pop psw)
CAROK:	JMP	0		;test for carrier
MDIN:	JMP	0		;receive data byte
GETCHR:	JMP	0		;get char. from modem
RCVRDY:	JMP	0		;check receive ready
SNDRDY:	JMP	0		;check send ready (a=errcde)
SPEED:	JMP	0		;get speed value for transfer time
EXTRA1:	JMP	0		;extra for custom routine
EXTRA2:	JMP	0		;extra for custom routine
EXTRA3:	JMP	0		;extra for custom routine
;
;-----------------------------------------------------------------------
;
	 IF	NOT LARGEIO	;i/o patch area size up to 128 bytes
	DS	100H
	 ENDIF

	 IF	LARGEIO 	;i/o patch area size if over 128 bytes
	ORG	BASE+100H+IOSIZE
	 ENDIF
;
; Save CP/M stack, initialize new one for this program
;
BEGIN:	LXI	H,0
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK	;initialize new stack
	lxi	d,2000h
	mvi	c,26
	call	5
	mvi	b,0
	mvi	c,41
	mvi	e,81h
	call	50h
	lda	2000h
	sta	aclvl
	mvi	c,26
	lxi	d,80h
	call	5
	mvi	c,12
	call	bdos
	mov	a,e
	lxi	d,lstcft
	call	ma3dc
;
; Save the current drive and user area
;
	MVI	E,0FFH		;get the current user area
	MVI	C,USER
	CALL	BDOS
	STA	OLDUSR		;save user number here
	MVI	C,CURDRV	;get the current drive
	CALL	BDOS
	STA	OLDDRV		;save drive here
	CALL	print		;print:
	DB	CR,LF,'XMODEM-TD-SENECA v',VERSION+'0','.',MODLEV+'0',' ',0
;
; Get option
;
	LXI	H,FCB+2 	;first off, check for "p" (private)
	MOV	A,M
	CPI	'P'             ;if not, then normal stuff...
	JNZ	CKOPT
	DCX	H		;first character in buffer
	MOV	A,M
	CPI	'R'
	JNZ	OPTNERR 	;if not, is an error
	STA	PRVTFL		;otherwise set 'PRIVATE' flag
	INX	H
	INX	H
	MOV	A,M
	CPI	'C'             ;checksum checking requested?
	JZ	CKOPT1 	;if yes, go set flag
	JMP	CKOPT2
;
CKOPT:	CPI	'C'             ;checksum checking requested?
	JNZ	CKOPT2 	;no, go check primary
	LDA	FCB+1		;get primary option
	CPI	'R'             ;checksum only for receive
	JNZ	OPTNERR 	;print error message then abort
;
CKOPT1:STA	CRCFLG		;turn on the checksum flag
;
CKOPT2:LDA	FCB+1		;get option (l, r or s)
	STA	OPTSAV		;save option for later use
	PUSH	PSW
	CPI	'R'
	jz	cko21
	JMP	CKOPT4
;
cko21:	LDA	CRCFLG
	ORA	A
	JZ	CKOPT3
	CALL	print
	DB	'Checksum enabled',0
	JMP	CKOPT4
;
CKOPT3:CALL	print
	DB	'(CRC is enabled)',0
;
CKOPT4:CALL	print
	DB	CR,LF,0
;
	CALL	MINIT
;
; Jump to appropriate function
;
	POP	PSW		;get option
;
	 IF	LGCL
	PUSH	PSW		;but save it
	 ENDIF			;LGCL
;
	CPI	'L'             ;to send a file from a library?
	JNZ	NOL
	JMP	SENDFIL
;
NOL:	CPI	'R'             ;to receive a file?
	JZ	RCVFIL
	CPI	'S'
	JZ	SENDFIL 	;otherwise go send a file
;
; Invalid option
;
OPTNERR:CALL	print
	DB	CR,LF,'++ Examples of valid options: ++',0
;
	 IF	NOT SETAREA
	CALL	print
	DB	CR,LF,0
	 ENDIF			;NOT SETAREA
;
	 IF	SETAREA
	CALL	print
	DB	'   (Uploads files to ',DRV,0
	LXI	H,USR
	CALL	DECOUT
	CALL	print
	DB	':)',CR,LF,0
	 ENDIF			;SETAREA
;
	CALL	ERXIT		;exit with error
	DB	'   XMODEM L PRINT.LBR PRINT.INF    to send a file '
	DB	'from a library',CR,LF
	DB	'   XMODEM L CATALOG CAT2.OBJ       (.LBR extent may '
	DB	'be omitted)',CR,LF
	DB	'   XMODEM S FILENAME.TYP           to send a file'
	DB	CR,LF
	DB	'   XMODEM R (or RC) FILENAME.TYP   to receive a file'
	DB	CR,LF
	DB	'   XMODEM RP (or RPC) FILENAME.TYP to receive in a '
	DB	'private area',CR,LF,CR,LF
	DB	'   (The "C" in RC or RPC receives via checksum rather '
	DB	'than CRC)',cr,lf,lf
	db	'NOTE: L option for MEMBERS only$'
;	
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; ---> SENDFIL	sends a CP/M file
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; The CP/M file specified in the XMODEM command is transferred over the
; phone to another computer running modem with the "R" (receive) option.
; The data is sent one record at a time with headers and checksums, and
; retransmission on errors.
;
SENDFIL:CALL	LOGDU		;check file name or drive/user option
	LDA	OPTSAV
	CPI	'L'             ;if library option skip 'CNREC'
	CNZ	CNREC		;ignore if in library mode
	CALL	OPENFIL 	;open the file
	MVI	E,100		;wait 100 sec for initial nak
	CALL	WAITNAK
;
SENDLP:	CALL	RDRECD		;read a record
	JC	SENDEOF 	;send 'EOF' if done
	CALL	INCRRNO 	;bump record number
	XRA	A		;initialize error count to zero
	STA	ERRCT
;
SENDRPT:CALL	SENDHDR 	;send a header
	CALL	SENDREC 	;send data record
	LDA	CRCFLG		;get 'CRC' flag
	ORA	A		;'CRC' in effect?
	CZ	SENDCRC 	;yes, send 'CRC'
	CNZ	SENDCKS 	;no, send checksum
	CALL	GETACK		;get the 'ACK'
	JC	SENDRPT 	;repeat if no 'ACK'
	LDA	OPTSAV		;get the command option again
	CPI	'L'
	JNZ	SNRPT1		;if not library option, exit
	LHLD	RCNT
	MOV	A,H
	ORA	L		;see if l and h both zero now
	JZ	SENDEOF 	;if finished, exit
	DCX	H		;if not both zero, more remaining
	SHLD	RCNT		;one less to go
;
SNRPT1:	JMP	SENDLP		;loop until eof
;
; File sent, send EOT's
;
SENDEOF:MVI     A,EOT           ;send an 'EOT'
	CALL	SEND
	CALL	GETACK		;get the ack
	JC	SENDEOF 	;loop if no ack
	JMP	EXITLG		;all done
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; ---> RCVFIL	Receive a CP/M file
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; Receives a file in block format as sent by another person doing
; "XMODEM S FM.FT".  Can be invoked by "XMODEM R FN.FT" or by
; "XMODEM RC FN.FT" if Checksum is to be used.
;
RCVFIL:	CALL	LOGDU		;check file name or drive/user option
;
	 IF	SETAREA
	MVI	A,DRV-40H
	STA	FCB
	 ENDIF			;SETAREA
;
	LDA	PRVTFL		;receiving to a private area?
	ORA	A
	JZ	RCVFL1 	;if not, exit
	MVI	A,PRDRV-40H	;private area takes precedence
	STA	FCB		;store drive to be used
;
RCVFL1: IF	NOCOMR
	LXI	H,FCB+9 	;point to filetype
	MVI	A,'C'           ;1st letter
	CMP	M		;is it c ?
	JNZ	CONTNU 	;if not, continue normally
	INX	H		;get 2nd letter
	MVI	A,'O'           ;2nd letter
	CMP	M		;is it o ?
	JNZ	CONTNU 	;if not, continue normally
	INX	H		;get 3rd letter
	MVI	A,'M'           ;3rd letter
	CMP	M		;is it m ?
	JNZ	CONTNU 	;if not, continue normally
	CALL	print		;print renaming message
	DB	'Auto-renaming file to ".OBJ"',CR,LF,0
	LXI	H,FCB+9
	MVI	M,'O'
	INX	H
	MVI	M,'B'
	INX	H
	MVI	M,'J'
norest:
	 ENDIF			;NOCMR
;
CONTNU:CALL	print		;print the message
	DB	'File will be received on ',0
	LDA	PRVTFL		;going to store in the private area?
	ORA	A
	LDA	XPRDRV		;get private drive
	JNZ	CONTN1 	;if yes, it takes priority
	LDA	OLDDRV		;otherwise get current drive
	ADI	'A'             ;convert to ascii
;
	 IF	SETAREA
	LDA	XDRV		;setarea uses a specified drive
	 ENDIF			;SETAREA
;
	 IF	NOT SETAREA
NOTDRV:	DB	0,0		;filled in by 'GETDU' if requested
	 ENDIF			;NOT SETAREA
;
CONTN1:CALL	CTYPE		;print the drive to store on
	LDA	PRVTFL		;going to store in the private area?
	ORA	A
	LDA	XPRUSR		;get private user area
	JNZ	CONTN2 	;if yes, it takes priority
	LDA	OLDUSR		;get current drive
;
	 IF	SETAREA
	LDA	XUSR		;setarea takes next precedence
	 ENDIF			;SETAREA
;
	 IF	NOT SETAREA
NOTUSR:	DB	0,0		;filled in by 'GETDU' if requested
	 ENDIF			;NOT SETAREA
;
CONTN2:MVI	H,0
	MOV	L,A
	CALL	DECOUT		;print the user area
	CALL	print
	DB	':',CR,LF,0
	CALL	CHEKFIL 	;see if file exists
	CALL	MAKEFIL 	;if not, start a new file
	CALL	print
	DB	'File open - ready to receive',CR,LF,0
	call	freesp
;
RCVLP:	CALL	RCVRECD 	;get a record
	JC	RCVEOT		;got 'EOT'
	CALL	WRRECD		;write the record
	CALL	INCRRNO 	;bump record number
	CALL	SENDACK 	;ack the record
	JMP	RCVLP		;loop until 'EOF'
;
; Got EOT on record so flush buffers then done
;
RCVEOT:	CALL	WRBLOCK 	;write the last block
	CALL	SENDACK 	;ack the record
	CALL	CLOSFIL 	;close the file
	JMP	EXITLG		;all done
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;			SUBROUTINES
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; ---> LOGDU  Log into drive and user (if specified).  If none mentioned
;	      it falls through to 'TRAP' routine for normal use.
;
LOGDU:	LXI	H,DEFDMA	;point to default buffer command line
	MOV	B,M		;store number of chars. in command
	INR	B		;add in current location
LOG1:	CALL	CHKSP		;skip spaces to find 1st command
	JZ	LOG1
LOG2:	CALL	CHKSP		;skip 1st command (non-spaces)
	JNZ	LOG2
	INX	H
	CALL	CHKFSP		;skip spaces to find 2nd command
	SHLD	SAVEHL		;save start address of the 2nd command
;
; Now point to the first byte in the argument, i.e., if it was of format
; similar to:  B6:HELLO.DOC then we point at the drive character 'B'.
;
	MVI	C,4		;drive/user is 4 chars. maximum
CPLP:	MOV	A,M
	CPI	' '+1           ;space or return, finished
	JC	TRAP
	INX	H
	CPI	':'
	JZ	GETDU		;if colon, get drive/user and log in
	DCR	B		;one less position to check
	DCR	C		;one less to go
	JNZ	CPLP
;
; ---> TRAP  Check for no file name or ambiguous name
;
TRAP:	CALL	MOVEFCB 	;move the filename into the file block
	LXI	H,FCB+1 	;point to file name
	MOV	A,M		;get first char of file name
	CPI	' '             ;any there?
	JNZ	ATRAP		;yes, check for ambigous file name
NFN:	CALL	ERXIT		;print msg, exit
	DB	'++ No file name requested ++$'
;
ATRAP:	MVI	B,11		;11 chars to check
TRLOOP:	MOV	A,M		;get char from fcb
	CPI	'?'             ;ambiguous?
	JZ	TRERR		;yes, exit with error msg
	CPI	'*'		;even more ambiguous??
	JZ	TRERR		;yes, exit with error msg
	INX	H		;point to next char
	DCR	B		;one less to go
	JNZ	TRLOOP		;not done, check some more
	RET
;
TRERR:	CALL	ERXIT		;print msg, exit
	DB	'++ Wild-card options are not valid ++$'
;
; ---> GETDU  Get <D>isk and <U>ser from DUSAVE and log in if valid.
;
GETDU:	CALL	CHKFSP		;see if a file name is included
	SHLD	SAVEHL		;save location of the filename
	LDA	PRVTFL		;uploading to a private area?
	ORA	A
	JNZ	TRAP		;if yes, going to a specified area
	LXI	H,DUSAVE	;point to drive/user
	MVI	A,YES		;reset to provide for current drive
	STA	DUD
	MOV	A,M		;get 1st char.
	CPI	'A'-1
	JC	NUMERIC 	;satisfied with current drive
	SUI	'A'
;
	 IF	NOT USEMAX
	CPI	MAXDRV
	JNC	ILLDU		;drive selection not available
	 ENDIF			;NOT USEMAX
;
	 IF	USEMAX
	PUSH	H
	LXI	H,DRIVMAX	;point to max drive byte
	INR	M
	CMP	M		;and check it
	PUSH	PSW		;save flags from the CMP
	DCR	M		;restore max drive to normal
	POP	PSW		;restore flags from the CPM
	JNC	ILLDU
	POP	H
	 ENDIF			;USEMAX
;
	STA	DUD		;save drive
	INX	H		;get 2nd character
;
NUMERIC:MOV	A,M
	CPI	':'
	JZ	OK4		;colon for drive only, no user number
	CALL	CKNUM		;check if numeric
	SUI	'0'             ;convert ascii to binary
	STA	DUU		;save it
	INX	H		;get 3rd character if any
	MOV	A,M
	CPI	':'
	JZ	OK1
	LDA	DUU
	CPI	1		;is first number a '1'?
	JNZ	ILLDU
	MOV	A,M
	CALL	CKNUM
	SUI	'0'-10
	STA	DUU
	INX	H		;get 4th (and last character) if any
	MOV	A,M
	CPI	':'
	JNZ	ILLDU
OK1:	LDA	OPTSAV		;get the option back
	CPI	'R'             ;receiving a file?
	LDA	DUU		;get desired user area
	JZ	OK2		;yes, can not use special download area
	LDA	DUD		;get desired drive
	CPI	SPLDRV-'A'      ;special download drive requested?
	LDA	DUU		;get user area requested
	JNZ	OK2		;if none, exit
	CPI	SPLUSR		;special download area requested?
	JZ	OK3		;if yes, process request
;
OK2:	 IF	NOT USEMAX
	CPI	MAXUSR+1	;check for maximum user download area
	JNC	ILLDU		;error if more (and not special area)
	 ENDIF			;NOT USEMAX
;
	 IF	USEMAX
	PUSH	H
	LXI	H,USRMAX	;point at max user byte
	CMP	M		;and check it
	JNC	ILLDU
	POP	H
	 ENDIF			;USEMAX
;
OK3:	MOV	E,A
;
	 IF	NOT SETAREA
	STA	NOTUSR+1	;store requested user area
	MVI	A,3EH		;'MVI A,--' instruction
	STA	NOTUSR
	 ENDIF			;NOT SETAREA
;
	MVI	C,USER
	CALL	BDOS		;set to requested user area
OK4:	LDA	DUD		;get drive
	MOV	E,A
;
	 IF	NOT SETAREA
	ADI	'A'
	STA	NOTDRV+1	;store requested drive
	MVI	A,3EH		;'MVI A,--' instruction
	STA	NOTDRV
	 ENDIF			;NOT SETAREA
;
	MVI	C,SELDRV
	CALL	BDOS		;set to requested drive
XIT:	JMP	TRAP		;now find file selected
;
CKNUM:	CPI	'0'
	JC	ILLDU		;error if less than ascii '0'
	CPI	'9'+1
	RC			;error if more than ascii '9'
;
ILLDU:	CALL	ERXIT
	DB	'++ Improper drive/user combination ++$'
;
; Check next character to see if a space or non-space, file name error
; if no ASCII character.
;
CHKFSP:	DCR	B
	JZ	NFN		;error if end of chars.
	MOV	A,M
	CPI	' '+1
	RNC			;ok if valid character so return
	INX	H
	JMP	CHKFSP		;look at next character
;
; Check next character to see if a space or non-space, go to menu if a
; command error.
;
CHKSP:	DCR	B
	JZ	OPTNERR
	INX	H
	MOV	A,M		;get the char. there
	CPI	' '             ;space character?
	RET			;jz = space, jnz = non-space
;
; ---> RCVRECD	Receive a record
;
; Returns with carry bit set if EOT received
;
RCVRECD:XRA	A		;initialize error count to zero
	STA	ERRCT
RCVRPT:	XRA	A		;get 0
	STA	ERRCDE		;clear receive error code
	MVI	B,15-1		;15-second timeout
	CALL	RECV		;get any character received
	JC	RCVSTOT 	;timeout
	CALL	RCVRR		;error during receive?
	CPI	SOH		;hoping for a 'SOH'
	JZ	RCVSOH		;yes
	ORA	A
	JZ	RCVRPT		;ignore nulls
	CPI	CRC		;ignore our own 'CRC' if needed
	JZ	RCVRPT
	CPI	NAK		;ignore our own 'NAK' if needed
	JZ	RCVRPT
	CPI	EOT		;end of transfer?
	STC			;return with carry set if 'EOT'
	RZ
;
; Didn't get SOH or EOT - or - didn't get valid header - purge the line,
; then send nak
;
RCVSRR:MVI	B,1		;wait for 1 second
	CALL	RECV		;after last char. received
	JNC	RCVSRR 	;loop until sender done
	LDA	CRCFLG		;get 'CRC' flag
	ORA	A		;'CRC' in effect?
	MVI	A,NAK		;put 'NAK' in accum
	JNZ	RCVSR2 	;no, send the 'NAK'
	LDA	FRSTIM		;get first time switch
	ORA	A		;has first 'SOH' been received?
	MVI	A,NAK
	JNZ	RCVSR2 	;yes, then send 'NAK'
	MVI	A,CRC		;tell sender 'CRC' is in effect
;
RCVSR2:CALL	SEND		;   the 'NAK' or 'CRC' request
	LDA	ERRCT		;abort if
	INR	A		;   we have reached
	STA	ERRCT		;the error
	CPI	10		;   limit?
	jz	rcvsabt
	cpi	5
	JC	RCVRPT		;   no, try again
	mvi	a,'C'
	sta	crcflg
	jmp	rcvrpt
;
; Error limit exceeded, so abort
;
RCVSABT:CALL	CLOSFIL 	;keep whatever we got
	CALL	print
	DB	CR,LF,CR,LF,'++ RECEIVED FILE CANCELLED ++',0
	CALL	DELFILE 	;delete received file
	CALL	ERXIT		;print second half of message
	DB	'++ UNFINISHED FILE DELETED ++$'
;
; ---> DELFILE	deletes the received file (used if receive aborts)
;
DELFILE:LXI	D,FCB		;point to file
	MVI	C,ERASEF	;get function
	CALL	BDOS		;delete it
	INR	A		;delete ok?
	RNZ			;  yes, return
	CALL	ERXIT		;  no, abort
	DB	'++ Can''t delete received file ++$'
;
; Timed out on receive
;
RCVSTOT:JMP	RCVSRR 	;bump error count, etc.
;
; ---> RCVRR	Checks to see if framing error, overrun, or parity error
;		occured
;		   1. error code (ERRCDE) was set in receive routine
;		   2. errcde=0 for no errors, ERRCDE<>0 for errors
;
RCVRR:	 IF	ALTOS OR EXTMOD OR INTER3
	RET
	 ENDIF
;
	PUSH	PSW		;save received character
	LDA	ERRCDE		;check for any receive error
	ORA	A
	JNZ	RCVRR1 	;if error, exit
	POP	PSW		;if no error, get received char. back
	RET
;
RCVRR1:POP	PSW		;restore char transmitted
	POP	PSW		;restore 'CALL' on stack
	JMP	RCVSRR 	;purge line, send 'NAK', continue
;
; Got SOH - get block number, block number complemented
;
RCVSOH:	MVI	B,1		;timeout = 1 sec
	STA	FRSTIM		;indicate first 'SOH' received
	CALL	RECV		;get record
	JC	RCVSTOT 	;got timeout
	CALL	RCVRR		;trans error?
	MOV	D,A		;d=blk number
	MVI	B,1		;timeout = 1 sec
	CALL	RECV		;get complimented record number
	JC	RCVSTOT 	;timeout
	CALL	RCVRR		;trans error?
	CMA			;calc complement
	CMP	D		;good record number?
	JZ	RCVDATA 	;yes, get data
;
; Got bad record number
;
	JMP	RCVSRR 	;bump error count
;
RCVDATA:MOV	A,D		;get record number
	STA	RCVRNO		;save it
	MVI	C,0		;init cksum
	CALL	CLRCRC		;clear crc counter
	MVI	D,128		;init count
	LHLD	RECPTR		;get buffer address
RCVCHR:	MVI	B,1		;1 sec timeout
	CALL	RECV		;get char
	JC	RCVSTOT 	;timeout
	CALL	RCVRR		;trans error?
	MOV	M,A		;store char
	INX	H		;point to next char
	DCR	D		;done?
	JNZ	RCVCHR		;no, loop if <= 128
	LDA	CRCFLG		;get 'CRC' flag
	ORA	A		;'CRC' in effect?
	JZ	RCRC		;yes, to receive 'CRC'
;
; Verify checksum
;
	MOV	D,C		;save checksum
	MVI	B,1		;timeout len.
	CALL	RECV		;get checksum
	JC	RCVSTOT 	;timeout
	CALL	RCVRR		;error during receive?
	CMP	D		;checksum ok?
	JNZ	RCVSRR 	;no, error
;
; Got a record, it's a duplicate if = previous, or OK if = 1 + previous
; record
;
CHKSNUM:LDA	RCVRNO		;get received
	MOV	B,A		;save it
	LDA	RECDNO		;get previous
	CMP	B		;prev repeated?
        JZ      RECVACK         ;'ACK' to catch up
	INR	A		;calculate next record number
	CMP	B		;match?
	JNZ	ABORT		;no match - stop sender, exit
	RET			;carry off - no errors
;
; ---> RCRC	Receive the Cyclic Redundancy Check characters (2 bytes)
;		and see if the CRC received matches the one calculated.
;		If they match, get next record, else send a NAK request-
;		ing the record be sent again.
;
RCRC:	MVI	E,2		;number of bytes to receive
;
RCRC2:MVI	B,1		;1 sececond timeout
	CALL	RECV		;get crc byte
	JC	RCVSTOT 	;timeout
	CALL	RCVRR		;transmission error?
	DCR	E		;decrement num of bytes
	JNZ	RCRC2 	;get both bytes
	CALL	CHKCRC		;check rcvd crc against calc'D CRC
	ORA	A		;is crc okay?
	JZ	CHKSNUM 	;yes, go check record numbers
	JMP	RCVSRR 	;go check error limit and send nak
;
; Previous record repeated, due to the last ACK being garbaged.  ACK it
; so sender will catch up
;
RECVACK:CALL	SENDACK 	;send the ack,
	JMP	RCVRECD 	;get next block
;
; Send an ACK for the record
;
SENDACK:MVI     A,ACK           ;get 'ACK'
	CALL	SEND		;  and send it
	RET
;
; ---> SENDHDR	Send the record header
;
; Send	(SOH) (block number) (complemented block number)
;
SENDHDR:MVI	A,SOH		;send
	CALL	SEND		;  'SOH',
	LDA	RECDNO		;then send
	CALL	SEND		;  record number
	LDA	RECDNO		;then record number
	CMA			;  complemented
	CALL	SEND		;  record number
	RET			;from sendhdr
;
; ---> SENDREC	send the data record
;
SENDREC:MVI	C,0		;init cksum
	CALL	CLRCRC		;clear the 'CRC' counter
	MVI	D,128		;init count
	LHLD	RECPTR		;get buffer address
SENDC:	MOV	A,M		;get a char
	CALL	SEND		;send it
	INX	H		;point to next char
	DCR	D		;done?
	JNZ	SENDC		;loop if <=128
	RET			;from sendrec
;
; ---> SENDCKS	send the checksum
;
SENDCKS:MOV	A,C		;send the
	CALL	SEND		;  checksum
	RET			;from 'SENDCKS'
;
; ---> SENDCRC	Send the two Cyclic Redundancy Check characters.  Call
;		FINCRC to calculate the CRC which will be in 'DE' upon
;		return.
;
SENDCRC:CALL	FINCRC		;calculate the 'CRC' for this record
	MOV	A,D		;put first 'CRC' byte in accumulator
	CALL	SEND		;send it
	MOV	A,E		;put second 'CRC' byte in accumulator
	CALL	SEND		;send it
	XRA	A		;set zero return code
	RET
;
; ---> GETACK  Get the ACK on the record
;
; Returns with carry clear if ACK received.  If an ACK is not received,
; the error count is incremented, and if less than 10, carry is set and
; the record is resent.  if the error count is 10, the program aborts.
; waits 12 seconds to avoid any collision with the receiving station.
;
GETACK:	MVI	B,12		;wait 12 seconds max
	CALL	RECVDG		;receive with garbage collect
	JC	ACKERR		;timed out
	CPI	ACK		;was it an 'ACK' character?
	RZ			;yes, return
;
	 IF	NOT ACKNAK
	CPI	NAK		;was it an authentic 'NAK'?
	JNZ	GETACK		;ignore if neither 'ACK' nor 'NAK'
	 ENDIF			;NOT ACKNAK
;
; Timeout or error on ACK - bump error count then resend the record if
; error limit is not exceeded
;
ACKERR:	LDA	ERRCT		;get count
	INR	A		;bump it
	STA	ERRCT		;save back
	CPI	10		;at limit?
	RC			;if not, go resend the record
;
; Reached error limit
;
CSABORT:CALL	ERXIT
	DB	'++ SEND FILE CANCELLED ++$'
;
ABORT:	LXI	SP,STACK
ABORTL:	MVI	B,1		;one second without characters
	CALL	RECV
	JNC	ABORTL		;loop until sender done
	MVI	A,CAN		;ctl- x
	CALL	SEND		;stop sending end
ABORTW:	MVI	B,1		;one second without chracters
	CALL	RECV
	JNC	ABORTW		;loop until sender done
	MVI	A,CR		;get a space...
	CALL	SEND		;to clear out ctl-x
	CALL	ERXIT		;exit with abort message
	DB	'++ XMODEM',VERSION+'0',MODLEV+'0',' ABORTED ++$'  
;
; ---> INCRRNO	increment record number
;
INCRRNO:PUSH	H
	LHLD	RECDNO		;increment record number
	INX	H
	SHLD	RECDNO
	LHLD	CONOUT+1	;check to see if showing count on crt
	MOV	A,H		;if both zero, user did not fill out
	ORA	L		;   "conout:  jmp 0000h" in patch area
	JZ	INCRN5		;   with his own console output address
;
; Display the record count on the local CRT if "CONOUT" was filled in by
; the implementor

	MVI	A,1
	STA	CONONL		;set local only
	CALL	print
	DB	CR,'Record # ',0
	LHLD	RECDNO
	CALL	DHXOUT
	CALL	print
	DB	'H',0
	XRA	A		;reset the flag for local only
	STA	CONONL
;
INCRN5:	POP	H		;here from above if no conout
	RET
;
; ---> CHEKFIL	See if file exists
;
; If it exists, say use a different name.
;
CHEKFIL: IF	NOT SETAREA
	LDA	PRVTFL		;receiving in private area?
	ORA	A
	CNZ	RCAREA 	;if yes, set drive and user area
	 ENDIF			;NOT SETAREA
;
	 IF	SETAREA
	CALL	RCAREA 	;set the designated area up
	 ENDIF			;SETAREA
;
CHEKFIL1:
	LXI	D,FCB		;point to control block
	MVI	C,SRCHF 	;see if it
	CALL	BDOS		;   exists
	INR	A		;found?
	RZ			;   no, return
	CALL	ERXIT		;exit, print error message
	DB	'++ File exists, use a different name ++$'
;
; ---> MAKEFIL	Makes the file to be received
;
MAKEFIL:XRA	A		;set extent and record number to 0
	STA	FCBEXT
	STA	FCBRNO
	LXI	D,FCB		;point to fcb
	MVI	C,MAKE		;get bdos fnc
	CALL	BDOS		;to the make
	INR	A		;ff=bad?
	RNZ			;open ok
;
; Directory full - can't make file
;
	CALL	ERXIT
        DB      '++ Error: can''t make file -'
	DB	' directory may be full? ++$'
;
; ---> CNREC  Computes record count, and saves it until a successful
;	       file-open.
;
; Look up the FCB in the directory
;
CNREC:	MVI	C,CFSIZE	;computes file size
	LXI	D,FCB
	CALL	BDOS		;read first
	LHLD	RANDOM		;get the file size
	SHLD	RCNT		;save total record count
	MOV	A,H
	ORA	L
	RNZ			;return if not zero length
NONAME:	CALL	ERXIT
	DB	'++ No file with that name ++$'
;
; ---> OPENFIL	Opens the file to be sent
;
OPENFIL:XRA	A		;set extent and rec number to 0
	STA	FCBEXT		;  for proper open
	STA	FCBRNO
	LXI	D,FCB		;point to file
	MVI	C,OPEN		;get function
	CALL	BDOS		;open it
	INR	A		;open ok?
	JNZ	OPNOK		;if yes, exit
	LDA	OPTSAV		;get command line option
	CPI	'L'             ;want to send a library file?
	JNZ	NONAME		;exit, if not
	CALL	print
	DB	CR,LF,'++ No library file with that name ++',CR,LF,0
	JMP	OPTNERR
;
; Check for distribution-protected file
;
OPNOK:	LDA	FCB+1		;first char of file name
	ANI	80H		;check bit 7
	JNZ	OPENOT		;if on, file can not be sent
	LDA	FCB+2		;also check "f2" for tab
	ANI	80H		;is is set?
;
	 IF	NOSYS
	JNZ	OPENOT
	LDA	FCB+10
	ANI	80H
	JNZ	NONAME		;if $sys then fake a "file not found"
	 ENDIF
;
	JZ	OPNOK2 	;if not, ok to send file
OPENOT:	CALL	ERXIT		;exit with message
	DB	'++ File is not for distribution, sorry ++$'
;
OPNOK2:LDA	OPTSAV
	CPI	'L'
	JNZ	OPN2
	LXI	D,DEFDMA
	MVI	C,SETDMA
	CALL	BDOS
	MVI	C,READ
	LXI	D,FCB
	CALL	BDOS
	LHLD	8EH
	SHLD	DIRSZ
	LXI	H,DEFDMA
	MOV	A,M
	ORA	A
	JZ	CKDIR		;check directory present?
NOTLBR:	CALL	ERXIT
	DB	'++ Library directory invalid? ++$'
;
; --> CKDIR  Check to see if there is a .LBR file directory with that
;	     name and complain if not.
;
CKDIR:	MVI	B,11		;maximum length of file name
	MVI	A,' '		;first entry must be all blanks
	INX	H
CKDLP:	CMP	M
	JNZ	NOTLBR
	DCR	B
	INX	H
	JNZ	CKDLP
;
; The first entry in the .LBR directory is indeed blank.  Now see if the
; directory size is more than 0.
;
	MOV	D,M		;get directory starting location
	INX	H		;...which must be 0000H...
	MOV	A,M
	ORA	D
	JNZ	NOTLBR		;directory does not start in record 0
	INX	H
	MOV	A,M		;get size of directory
	INX	H
	ORA	M
	JZ	NOTLBR		;directory must be >0 sectors!
	LXI	H,DEFDMA	;point to directory
;
; The next routine checks the .LBR directory for the specified member.
; Name one sector at a time.
;
CMLP:	MOV	A,M		;get member active flag
	ORA	A		;00=active, anything else can be...
	MVI	B,11		;...regarded as invalid (erased or blank)
	INX	H		;point to member name
	JNZ	NOMTCH		;no match if inactive entry
CKLP:	LDAX	D		;now compare the file name specified...
	CMP	M		;...against the member file name
	JNZ	NOMTCH		;exit loop if no match found
	INX	H
	INX	D
	DCR	B
	JNZ	CKLP		;check all 11 chars
	MOV	E,M		;got the file - get file address
	INX	H
	MOV	D,M
	XCHG
	SHLD	INDEX		;save file addr in LBR
	XCHG
	INX	H
	MOV	E,M		;get the file size
	INX	H
	MOV	D,M
	XCHG
	DCX	H
	SHLD	RCNT		;save size as # of records
	LHLD	INDEX		;get file address
	SHLD	RANDOM		;place it into random field
	XRA	A
	STA	RANDOM+2	;must zero the 3rd byte
	STA	FCBRNO		;also zero FCB record #
	LXI	D,FCB		;point to FCB of LBR file
	MVI	C,RRDM		;read random
	CALL	BDOS
	JMP	OPNOK3		;no need to error check
;
; Come here if no file name match and another sector is needed
;
NOMTCH:	INX	H		;skip past the end of the file entry
	DCR	B
	JNZ	NOMTCH
	LXI	B,20		;point to next file entry
	DAD	B
	LXI	D,MEMFCB	;point to member name again
	MOV	A,H		;see if we checked all 4 entries
	ORA	A
	JZ	CMLP		;no, check next
	LHLD	DIRSZ		;get directory size
	MOV	A,H
	ORA	L
	JNZ	INLBR		;continue if still more to check
	CALL	ERXIT
	DB	'++ File not found in library ++$'
;
INLBR:	DCX	H		;decrement directory size
	SHLD	DIRSZ
	MVI	C,READ		;read next sector of directory
	LXI	D,FCB
	CALL	BDOS
	LXI	H,DEFDMA	;set our pointers for compare
	LXI	D,MEMFCB
	JMP	CMLP		;check next sector
;
OPN2:	 IF	NOLBS OR NOCOMS ;check for send restrictions
	LXI	H,FCB+11
	MOV	A,M		;check for protect attr
	ANI	7FH		;remove cp/m 2.x attrs
	 ENDIF			;NOLBS OR NOCOMS
;
	 IF	NOLBS		;do not allow '#' to be sent
	CPI	'#'             ;chk for '#' as last first
	JZ	OPENOT		;if '#', can not send, show why
	 ENDIF			;NOLBS
;
	 IF	NOCOMS		;do not allow '.COM' to be sent
	CPI	'M'             ;if not, check for '.COM'
	JNZ	OPNOK3 	;if not, ok to send
	DCX	H
	MOV	A,M		;check next character
	ANI	7FH		;strip attributes
	CPI	'O'             ;'O'?
	JNZ	OPNOK3 	;if not, ok to send
	DCX	H
	MOV	A,M		;now check 1st character
	ANI	7FH		;strip attributes
	CPI	'C'             ;'C' as in '.COM'?
	JNZ	OPNOK3 	;if not, continue
	CALL	ERXIT		;exit with message
	DB	'++ Can''t Send a .COM File ++$'
	 ENDIF			;NOCOMS
;
OPNOK3:	lda	aclvl
	ora	a
	jnz	norst
	lhld	rcnt
	mov	a,h
	ora	a
	jnz	nonono
	mov	a,l
	cpi	81
	jnc	nonono
norst:	CALL	print		;print:
	DB	'File open: ',0
	LHLD	RCNT		;get record count
	LDA	OPTSAV
	CPI	'L'
	JNZ	OPNOK4 	;if send from library add 1 to
	INX	H		;show correct record count
OPNOK4:call	decout
	call	print
	db	' (',0
	CALL	DHXOUT		;print hex number of records
	CALL	print
;
	DB	'H) records',CR,LF
	DB	'Send time: ',0
	CALL	SPEED		;get speed indicator
	LXI	D,0
	MOV	E,A		;set up for table access
	LXI	H,BTABLE	;point to baud factor table
	DAD	D		;index to proper factor
	MOV	A,M		;factor in 'A'
	LHLD	RCNT		;get number of records
	CALL	DIVHLA		;divide hl by value in a (records/min)
	PUSH	H
;
	 IF	LGCL
	SHLD	PGSIZE
	 ENDIF			;LGCL
;	
	MVI	H,0
	CALL	DECOUT		;print decimal number of minutes
	CALL	print
	DB	' mins, ',0
	LXI	H,RECTBL	;point to divisors for seconds calc.
	LXI	D,0
	CALL	SPEED		;get speed indicator
	MOV	E,A
	DAD	D		;index into table
	MOV	A,M		;get multiplier
	POP	H		;get remainder
	CALL	MULHA		;multiply 'H' by 'A'
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	MVI	H,0
	CALL	DECOUT		;print the seconds portion
	CALL	print
	DB	' secs at ',0
	LXI	H,SPTBL 	;start of baud rate speeds
	MVI	D,0		;zero the 'D' register
	CALL	SPEED		;get speed indicator
	ADD	A		;index into the baud rate table
	ADD	A
	MOV	E,A		;now have the index factor in 'DE'
	DAD	D		;add to 'HL'
	XCHG			;put address in 'DE' regs.
	MVI	C,PRINTF 	;show the baud
	CALL	BDOS
	CALL	print
	DB	' bps',CR,LF
	DB	'To cancel: use CTL-X',CR,LF,0
	RET
;
BTABLE:	DB	5,13,20,24,30,48,0
RECTBL:	DB	192,74,48,40,32,20,0
SPTBL:	DB	'110$','300$','450$','600$','710$','1200$'
;
nonono:	call	erxit
	db	cr,lf,lf
	db	'+++ File is too large for nonmembers +++',cr,lf,'$'
;
; ---> DIVHLA  Divides 'HL' by value in 'A'
;	       upon exit: L=quotient, H=remainder
;
DIVHLA:	PUSH	B
	MVI	B,8		;shift factor to 'B'
	MOV	C,A		;divisor to 'C'
DIV2:	XRA	A		;clear carry flag and accumulator
	DAD	H
	MOV	A,H
	SUB	C
	JM	DIV3		;dont borrow on neg results
	MOV	H,A
	MOV	A,L
	ORI	1		;borrow 1
	MOV	L,A
DIV3:	DCR	B
	JNZ	DIV2
	POP	B
	RET
;
; ---> MULHA  Multiply the value in 'H' by the value in 'A'
;	       Return with answer in 'HL'.
;
MULHA:	MOV	B,A		;put loop count in 'B'
	MVI	D,0
	MOV	E,H
	MOV	L,H
	MVI	H,0
MULLP:	DCR	B
	RZ
	DAD	D
	JMP	MULLP
	RET
;
; Shift the 'HL' pair one bit to the right
;
SHFTHL:	MOV	A,L
	RAR
	MOV	L,A
	ORA	A		;clear the carry bit
	MOV	A,H
	RAR
	MOV	H,A
	RNC
	MVI	A,80H
	ORA	L
	MOV	L,A
	RET
;
; ---> CLOSFIL	Closes the received file
;
CLOSFIL:LXI	D,FCB		;point to file
	MVI	C,CLOSE 	;get function
	CALL	BDOS		;close it
	INR	A		;close ok?
	RNZ			;  yes, return
	CALL	ERXIT		;  no, abort
	DB	'++ Can''t close file ++$'
;
; ---> DECOUT  Decimal output routine
;
DECOUT:	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10
	LXI	D,-1
DECOU2:	DAD	B
	INX	D
	JC	DECOU2
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOUT
	MOV	A,E
	ADI	'0'
	CALL	CTYPE
	POP	H
	POP	D
	POP	B
	RET
;
; ---> DHXOUT  Double precision hex output routine.  Call with hex
;	       value in 'HL'.
;
DHXOUT:	PUSH	H		;save h,l
	PUSH	PSW		;save a
	MOV	A,H		;get ms byte
	CALL	HEXO		;output high order byte
	MOV	A,L		;get ls byte
	CALL	HEXO		;output low order byte
	POP	PSW		;restore a
	POP	H		;restore h,l
	RET			;return to caller
;
; ---> RDRECD  Reads a record
;
; For speed, this routine buffers up 16 records at a time.
;
RDRECD:	LDA	RECNBF		;get number of records in buffer
	DCR	A		;decrement it
	STA	RECNBF
	CPI	0FFH
	JZ	RDBLOCK 	;exhausted?  need more
	LHLD	RECPTR		;get buffer address
	LXI	D,128		;add length of one record
	DAD	D		;  to next buffer
	SHLD	RECPTR		;save buffer address
	RET			;from "readred"
;
; Buffer is empty - read in another block of 16
;
RDBLOCK:LDA	EOFLG		;get 'EOF' flag
	CPI	1		;is it set?
	STC			;to show 'EOF'
	RZ			;got 'EOF'
	MVI	C,0		;records in block
	LXI	D,DBUF		;to disk buffer
RDRECLP:PUSH	B
	PUSH	D
	MVI	C,SETDMA	;set dma address
	CALL	BDOS
	LXI	D,FCB
	MVI	C,READ
	CALL	BDOS
	POP	D
	POP	B
	ORA	A		;read ok?
	JZ	RDRECOK 	;yes
	DCR	A		;'EOF'?
	JZ	REOF		;got 'EOF'
;
; Read error
;
	CALL	ERXIT
	DB	'++ File read error ++$'
;
RDRECOK:LXI	H,128		;add length of one record
	DAD	D		;  to next buffer
	XCHG			;buff to de
	INR	C		;more records?
	MOV	A,C		;get count
	CPI	200		;done?
	JZ	RDBFULL 	;  yes, buffer is full
	JMP	RDRECLP 	;read more
;
REOF:	MVI	A,1
	STA	EOFLG		;set eof flag
	MOV	A,C
;
; Buffer is full, or got eof
;
RDBFULL:STA	RECNBF		;store record count
	LXI	H,DBUF-128	;init buffer pointear
	SHLD	RECPTR		;save buffer address
	LXI	D,DEFDMA	;reset dma address
	MVI	C,SETDMA
	CALL	BDOS
	JMP	RDRECD		;pass record to caller
;
; ---> WRRECD  Write a record
;
; Writes the record into a buffer.  When 16 have been written, writes
; the block to disk.
;
; Entry point "WRBLOCK" flushes the buffer at EOF
;
WRRECD:	LHLD	RECPTR		;get buffer address
	LXI	D,128		;add length of one record
	DAD	D		;  to next buffer
	SHLD	RECPTR		;save buffer address
	LDA	RECNBF		;bump the
	INR	A		;  record number
	STA	RECNBF		;  in the buffer
	CPI	200		;have we 16?
	RNZ			;no, return
;
; ---> WRBLOCK	Writes a block to disk
;
WRBLOCK:LDA	RECNBF		;number of records in the buffer
	ORA	A		;0 means end of file
	RZ			;none to write
	MOV	C,A		;save count
	LXI	D,DBUF		;point to disk buff
DKWRLP:	PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,SETDMA	;set dma
	CALL	BDOS		;to buffer
	LXI	D,FCB		;then write the block
	MVI	C,WRITE
	CALL	BDOS
	POP	B
	POP	D
	POP	H
	ORA	A
	JNZ	WRERR		;oops, error
	LXI	H,128		;length of 1 record
	DAD	D		;'HL'= next buff
	XCHG			;to 'DE' for setdma
	DCR	C		;more records?
	JNZ	DKWRLP		;  yes, loop
	XRA	A		;get a zero
	STA	RECNBF		;reset number of records
	LXI	H,DBUF		;reset buffer buffer
	SHLD	RECPTR		;save buffer address
RSDMA:	LXI	D,DEFDMA	;reset dma address
	MVI	C,SETDMA
	CALL	BDOS
	RET
;
WRERR:	CALL	RSDMA		;reset dma to normal
	MVI	C,CAN		;cancel
	CALL	SEND		;  sender
	CALL	RCVSABT 	;kill receive file
	CALL	ERXIT		;exit with msg:
	DB	'++ Error writing file ++$'
;
;----> RECV  Receive a character
;
; Timeout time is in 'B' in seconds.  Entry via 'RECVDG' deletes garbage
; characters on the line.  For example, having just sent a record,
; calling 'RECVDG' will delete any line-noise-induced characters "long"
; before the ACK/NAK would be received.
;
RECVDG:
RECV:	PUSH	D		;save 'DE' regs.
	MVI	E,MHZ		;get the clock speed
	XRA	A		;clear the 'A' reg.
MSLOOP:	ADD	B		;number of seconds
	DCR	E		;one less mhz. to go
	JNZ	MSLOOP		;if not zero, continue
	MOV	B,A		;put total value back into 'B'
MSEC:	LXI	D,0205h		;1 second dcr count
MWTI:	CALL	RCVRDY		;input from modem ready
;
	 IF	(NOT INTER3) AND (NOT ALTOS) AND (NOT EXTMOD)
	STA	ERRCDE
	 ENDIF
;
	JZ	MCHAR		;got char
	DCR	E		;count down for timeout
	JNZ	MWTI
	DCR	D
	JNZ	MWTI
	DCR	B		;more seconds?
	JNZ	MSEC		;yes, wait
;
; Test for the presence of carrier - if none, go to 'CARCK' and continue
; testing for specified time.  If carrier returns, continue.  If is doesn't
; return, exit.
;
	CALL	CAROK		;is carrier still on?
	CNZ	CARCK		;if not, test for 15 seconds
;
; Modem timed out receiving - but carrier is still on.
;
	POP	D		;restore d,e
	STC			;carry shows timeout
	RET
;
; Get character from modem.
;
MCHAR:	CALL	MDIN		;get data byte from modem
        POP     D               ;restore 'DE'
;
; Calculate Checksum and CRC
;
	PUSH	PSW		;save the character
	CALL	UPDCRC		;calculate crc
	ADD	C		;add to checksum
	MOV	C,A		;save checksum
	POP	PSW		;restore char
	ORA	A		;carry off: no error
	RET			;from "recv"
;
; CARCK - common carrier test for recv and send.  If carrier returns
; within TIMOUT seconds, normal program execution continues.  Else,
; it will abort to CP/M via EXIT.
;
CARCK:	MVI	E,TIMOUT*10	;value for 15 second delay
CARCK1:	CALL	DELAY		;kill .1 seconds
	CALL	CAROK		;is carrier still on?
	RZ			;return if carrier on
	DCR	E		;has 15 seconds expired?
	JNZ	CARCK1		;if not, continue testing
;
; See if got a local console, and report if so.
;
	LHLD	CONOUT+1	;get conout address
	MOV	A,H		;zero if no local console
	ORA	L
	JZ	CARCK2
;
	MVI	A,1		;print local only
	STA	CONONL
	CALL	print		;report loss of carrier
	DB	CR,LF,'++ Carrier lost in XMODEM ++',CR,LF,0
CARCK2:	LDA	OPTSAV		;get option
	CPI	'R'             ;if not receive
	JNZ	EXIT		;then abort now, else
	CALL	DELFILE 	;get rid of the junk first
	JMP	EXIT		;else, abort to cp/m.
;
; Delay - 100 millisecond delay.
;
DELAY:	PUSH	B		;save 'BC'
	LXI	B,MHZ*4167	;value for 100 ms. delay
DELAY2:	DCX	B		;update count
	MOV	A,B		;get ms byte
	ORA	C		;count = zero?
	JNZ	DELAY2		;if not, continue
	POP	B		;restore 'BC'
	RET			;return to carck1.
;
; ---> SEND  Send a character to the modem
;
SEND:	PUSH	PSW		;save the character
	CALL	UPDCRC		;calc the crc
	ADD	C		;calc cksum
	MOV	C,A		;save cksum
SENDW:	CALL	SNDRDY		;is transmit ready
	JZ	SENDR		;  yes, go send
;
; Xmit status not ready, so test for carrier before looping - if lost,
; go to CARCK and give it up to 15 seconds to return.  If it doesn't,
; return abort via EXIT.
;
        PUSH    D               ;save 'DE'
	CALL	CAROK		;is carrier still on?
	CNZ	CARCK		;if not, continue testing it
	POP	D		;restore 'DE'
	JMP	SENDW		;else, wait for xmit ready.
;
; ---> WAITNAK	Waits for initial NAK
;
; To ensure no data is sent until the receiving program is ready, this
; routine waits for the first timeout-nak or the letter 'C' for CRC
; from the receiver.  If CRC is in effect, then Cyclic Redundancy Checks
; are used instead of checksums.  'E' contains the number of seconds to
; wait.
;
; If the first character received is a CAN (CTL-X) then the send will be
; aborted as though it had timed out.
;
WAITNAK:MVI	B,1		;timeout delay
	CALL	RECV		;did we get
	CPI	CRC		;'CRC' indicated?
	RZ			;yes, send block
	CPI	NAK		;a 'NAK' indicating checksum?
	JZ	SETNAK		;yes go put checksum in effect
	CPI	CAN		;was it a cancel (ctl-x)?
	JZ	ABORT		;yes, abort
	DCR	E		;finished yet?
	JZ	ABORT		;yes, abort
	JMP	WAITNAK 	;no, loop
;
; ---> WAITCRC	Turn on CRC flag
;
SETNAK:	MVI	A,'C'           ;make sure in checksum
	STA	CRCFLG
	RET
;
; ---> MOVEFCB	Moves the filename to the FCB
;
; This routine moves the filename from the default command line buffer
; to the file control block (FCB).
;
MOVEFCB:LHLD	SAVEHL		;get position on command line
	CALL	GETB		;get numeric position
	LXI	D,FCB+1
	CALL	MOVENAM 	;move name to fcb
	XRA	A
	STA	FCBRNO		;zero record number
	STA	FCBEXT		;zero extent
	LDA	OPTSAV		;this going to be a library file?
	CPI	'L'
	RNZ			;if not, finished
;
; Handles library entries, first checks for proper .LBR extent.  If no
; extent was included, it adds one itself.
;
	SHLD	SAVEHL
	LXI	H,FCB+9 	;1st extent char.
	MOV	A,M
	CPI	' '
	JZ	NOEXT		;no extent, make one
	CPI	'L'             ;check 1st char. in extent
	JNZ	LBRERR
	INX	H		
	MOV	A,M
	CPI	'B'             ;check 2nd char. in extent
	JNZ	LBRERR
	INX	H
	MOV	A,M
	CPI	'R'             ;check 3rd char. in extent
	JNZ	LBRERR
;
; Get the name of the desired file in the library
;
MOVEF1:	LHLD	SAVEHL		;get current position on command line
	CALL	CHKMSP		;see if valid library member file name
	INR	B		;increment for move name
	LXI	D,MEMFCB	;store member name in special buffer
	JMP	MOVENAM 	;move from command line to buffer, done
;
; Check for any spaces prior to library member file name, if none (or
; only spaces remaining), no name.
;
CHKMSP:	DCR	B
	JZ	MEMERR
	MOV	A,M
	CPI	' '+1
	RNC
	INX	H
	JMP	CHKMSP
;
; Gets the count of characters remaining on the command line
;
GETB:	MOV	A,L
	SUI	DEFDMA+2	;start location of 1st command
	MOV	B,A		;store for now
	LDA	DEFDMA		;find length of command line
	SUB	B		;subtract those already used
	MOV	B,A		;now have number of bytes remaining
	RET
;
LBRERR:	CALL	ERXIT
	DB	'++ Invalid library name ++$'
;
MEMERR:	CALL	print
	DB	CR,LF,'++ No library member file requested ++',CR,LF,0
	JMP	OPTNERR
;
; Add .LBR extent to the library file name
;
NOEXT:	LXI	H,FCB+9 	;location of extent
	MVI	M,'L'
	INX	H
	MVI	M,'B'
	INX	H
	MVI	M,'R'
	JMP	MOVEF1		;now get the library member name
;
; Move a file name from the 'DEFDMA' command line buffer into FCB
;
MOVENAM:MVI	C,1
MOVEN1:	MOV	A,M
	CPI	' '+1           ;name ends with space or return
	RC			;end of name
	CPI	'.'
	JZ	CHKFIL		;file name might be less than 8 chars.
	STAX	D		;store
	INX	D		;next position to store char.
	INR	C		;one less to go
	MOV	A,C
	CPI	12+1
	JNC	NONAME		;11 chars. maximum filename plus extent
MOVEN2:	INX	H		;next char. in file name
	DCR	B
	JZ	OPTNERR 	;end of name, see if done yet
	JMP	MOVEN1
;
; See if any spaces needed between file name and .ext
;
CHKFIL:	MOV	A,C
	CPI	9
	JNC	MOVEN2		;up to 1st character in .ext now
	MVI	A,' '           ;be sure there is a blank there now
	STAX	D
	INR	C
	INX	D
	JMP	CHKFIL		;go do another
;
CTYPE:	PUSH	B		;save all registers
	PUSH	D
	PUSH	H
	MOV	E,A		;char to 'E' in case bdos (normal)
	LDA	CONONL		;want to bypass 'BYE' output to modem?
	ORA	A
	JNZ	CTYPEL		;yes, go directly to crt, then
	MVI	C,WRCON 	;bdos console output, to crt and modem
	CALL	BDOS		;   since "bye" intercepts the char.
	POP	H		;restore all registers
	POP	D
	POP	B
	RET
;
CTYPEL:	MOV	C,E		;bios needs it in 'C'
	CALL	CONOUT		;bios console output routine, not bdos
	POP	H		;restore all registers saved by 'CTYPE'
	POP	D
	POP	B
	RET
;
HEXO:	PUSH	PSW		;save for right digit
	RAR			;right justify the left digit
	RAR
	RAR
	RAR
	CALL	NIBBL		;print left digit
	POP	PSW		;restore right
;
; Slick new nybble hex maker. If this catches on, hex digits
; will never be the same... Lifted from BYE.ASM.
;
NIBBL:	ANI	0FH		;isolate digit
	ADI	90H
	DAA
	ACI	40H
	DAA
	JMP	CTYPE		;type it
;
EXITLG:
	 IF	LGCL		;special log caller exit
	JMP	LGCLL
	 ENDIF			;LGCL
;
	JMP	EXIT
;
;
; ---> ERXIT  Exit printing message following call
;
ERXIT:	CALL	print
	DB	CR,LF,0
	POP	D		;get message
	MVI	C,PRINTF 	;get bdos fnc
	CALL	BDOS		;print message
	CALL	print
	DB	CR,LF,0
EXIT:	CALL	UNINIT		;reset vectors (if needed)
	LDA	OLDDRV		;restore the original drive
	MOV	E,A
	CALL	RECDRX
	LDA	OLDUSR		;restore the original number
	MOV	E,A
	CALL	RCARE
	XRA	A
	LHLD	STACK
	SPHL
	RET
;
; ---> ILPRT  Inline print of message
;
; The call to ILPRT is followed by a message, binary 0 for its end.
;
PRINT:	XTHL			;save HL, get HL=message
ILPLP:	MOV	A,M		;get the character
	INX	H		;to next character
	ORA	A		;end of message?
	JZ	ILPRET		;  yes, return
	CALL	CTYPE		;type the message
	JMP	ILPLP		;loop
;
ILPRET:	XTHL			;restore HL
	RET			;past message
;
; ---> Restore the old user area and drive from a received file
;
; ---> Set user area to receive file
;
RCAREA:CALL	RECDRV		;ok set the drive to its place
	LDA	PRVTFL		;private area wanted?
	ORA	A
	MVI	E,PRUSR 	;yes, set to private area
	JNZ	RCARE
	MVI	E,USR		;ok now set the user area
RCARE:	MVI	C,USER		;tell bdos what we want to do
	CALL	BDOS		;do it
	RET
;
RECDRV:	LDA	PRVTFL
	ORA	A
	MVI	E,PRDRV-'A'     ;make drive cp/m number
	JNZ	RECDRX
	MVI	E,DRV-'A'       ;make drive cp/m number
RECDRX:	MVI	C,SELDRV	;tell bdos
	CALL	BDOS		;do it
	RET			;back
;
; Move 128 characters from 'HL' to 'DE' length in 'B'
;
MOVE128: MVI	B,128		;set move count
MOVE:	MOV	A,M		;get a char
	STAX	D		;store it
	INX	H		;to next "from"
	INX	D		;to next "to"
	DCR	B		;more?
	JNZ	MOVE		;  yes, loop
	RET			;  no, return
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
	 IF	LGCL
;
BSIZE:	EQU	80H
SECT:	EQU	80H
;
; The following allocations are used by the 'FILE' macros
;
DFLT$USER:	DB	LASTUSR
CUR$USER:	DB	0FFH
DFLT$DISK:	DB	LOGDRV-'A'
CUR$DISK:	DB	0FFH
PGSIZE:		DB	0,0
;
LGCLL:	JMP	M010
;
FCBCLLR:	DB	0,'LASTCALR'
lstcft:		db	'000',0 ;the file name has ALWAYS been
		DS	23		  ;LASTCALR, not LASTCALR.DAT!
		DB	0FFH
;
CLLRADR:	DW	DBUF
CLLRSIZ:	EQU	BSIZE
CLLRLEN:	DW	BSIZE
CLLRPTR:	DS	2
M010:		JMP	M001
;
GETCLLR:
	LHLD	CLLRLEN
	XCHG
	LHLD	CLLRPTR
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	M007
	LXI	H,0
	SHLD	CLLRPTR
M004:	XCHG
	LHLD	CLLRLEN
	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JNC	M006
	LHLD	CLLRADR
	DAD	D
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	LDA	FCBCLLR+36
	CPI	0FFH
	JZ	M009
	MVI	C,USER
	MOV	E,A
	CALL	BDOS
M009:	LXI	D,FCBCLLR
	MVI	C,RRDM
	CALL	BDOS
	CALL	RST$SYSTEM
	ORA	A
	JNZ	M005
	LHLD	FCBCLLR+33
	INX	H
	SHLD	FCBCLLR+33
	LXI	D,SECT
	LHLD	CLLRPTR
	DAD	D
	SHLD	CLLRPTR
	JMP	M004
;
M005:	LHLD	CLLRPTR
	SHLD	CLLRLEN
M006:	LXI	D,DEFDMA
	MVI	C,SETDMA
	CALL	BDOS
	LXI	H,0
	SHLD	CLLRPTR
M007:	XCHG
	LHLD	CLLRADR
	DAD	D
	XCHG
	LHLD	CLLRLEN
	MOV	A,L
	ORA	H
	MVI	A,EOF
	RZ
	LDAX	D
	LHLD	CLLRPTR
	INX	H
	SHLD	CLLRPTR
	RET
;
M001:	XRA	A
	STA	FCBCLLR+12
	STA	FCBCLLR+32
	LXI	H,CLLRSIZ
	SHLD	CLLRLEN
	SHLD	CLLRPTR
	LXI	D,FCBCLLR
	JMP	M011
;
OPENF:	PUSH	D	
	MVI	A,0FFH		;declare current user area on file
	STA	FILEUA
	MVI	C,VERNO		;get version number
	CALL	BDOS
	MOV	A,H		;cp/m 1.x?
	ORA	L
	JZ	START2$DISK	;check for default disk if so
	MVI	E,0FFH		;get current user number
	MVI	C,USER		;get user code
	CALL	BDOS
	MOV	C,A
	LDA	DFLT$USER	;check if at default user
	CMP	C
	JZ	START2$DISK	;do not try if at default user area
	STA	FILEUA		;where the file is if anywhere
	MOV	E,A
	MOV	A,C
	STA	CUR$USER	;where we are (save for later)
	MVI	C,USER		;set user code to default$user
	CALL	BDOS
START2$DISK:
	MVI	C,CURDRV	;see if current disk is default drive
	CALL	BDOS
	MOV	C,A
	LDA	DFLT$DISK	;check if at default disk
	CMP	C
	POP	H		;fcb into hl
	PUSH	H		;preserve stack
	JZ	START3$DISK
	INR	A		;add one to disk number
	MOV	M,A		;put into fcb
START3$DISK:
	XCHG			;fcb into de
	MVI	C,OPEN		;open file
	CALL	BDOS
	CPI	255		;not present?
M012:	POP	D		;get the fcb again(and clean up stack)
	PUSH	PSW		;save open status on file
	LXI	H,36
	DAD	D
	LDA	FILEUA		;get the user area for the file
	MOV	M,A		;put user area into fcb
	POP	PSW
	RET
;
RST$SYSTEM:
	PUSH	PSW
	LDA	CUR$USER	;check user
	CPI	0FFH		;0ffh=no change
	JZ	RST$RET
	MOV	E,A		;user in e
	MVI	C,USER		;get/set user code
	CALL	BDOS
RST$RET:
	POP	PSW
	RET
;
FILEUA:	DS	1
;
M011:	CALL	OPENF
	JNZ	M003
	CALL	ERXIT
	DB	CR,LF
	DB	'NO CLLR FILE$'
;
M003:	MVI	C,SETRRD	;get random record #
	LXI	D,FCBCLLR
	CALL	BDOS
	CALL	RST$SYSTEM
	MVI	A,LOGUSR
	STA	DFLT$USER
	JMP	M022
;
FCBLOG:	DB	0,'LOG     SYS',0
	DS	23
	DB	0FFH
;
LOGADR:	DW	LOGBUF
LOGSIZ:	EQU	BSIZE
LOGLEN:	DW	BSIZE
LOGPTR:	DS	2
;
M022:	JMP	M013
;
GETLOG:	LHLD	LOGLEN
	XCHG
	LHLD	LOGPTR
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	M019
	LXI	H,0
	SHLD	LOGPTR
M016:	XCHG
	LHLD	LOGLEN
	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JNC	M018
	LHLD	LOGADR
	DAD	D
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	LDA	FCBLOG+36
	CPI	0FFH
	JZ	M021
	MVI	C,USER
	MOV	E,A
	CALL	BDOS
M021:	LXI	D,FCBLOG
	MVI	C,RRDM
	CALL	BDOS
	CALL	RST$SYSTEM
	ORA	A
	JNZ	M017
	LHLD	FCBLOG+33
	INX	H
	SHLD	FCBLOG+33
	LXI	D,SECT
	LHLD	LOGPTR
	DAD	D
	SHLD	LOGPTR
	JMP	M016
;
M017:	LHLD	LOGPTR
	SHLD	LOGLEN
M018:	LXI	D,DEFDMA
	MVI	C,SETDMA
	CALL	BDOS
	LXI	H,0
	SHLD	LOGPTR
M019:	XCHG
	LHLD	LOGADR
	DAD	D
	XCHG
	LHLD	LOGLEN
	MOV	A,L
	ORA	H
	MVI	A,EOF
	RZ
	LDAX	D
	LHLD	LOGPTR
	INX	H
	SHLD	LOGPTR
	RET
;
M013:	XRA	A
	STA	FCBLOG+12
	STA	FCBLOG+32
	LXI	H,LOGSIZ
	SHLD	LOGLEN
	SHLD	LOGPTR
	LXI	D,FCBLOG
	CALL	OPENF
	JNZ	M015
	MVI	A,EOF
	STA	LOGBUF
	LXI	H,0
	SHLD	LOGPTR
	LXI	D,FCBLOG
	MVI	C,MAKE
	CALL	BDOS
	INR	A
	JNZ	M015
	CALL	ERXIT
	DB	CR,LF
	DB	'NO DIR SPACE: LOG$'
;
BACKLOG:LXI	H,LOGSIZ
	SHLD	LOGLEN
	LHLD	LOGPTR
	MOV	A,L
	ORA	H
	RZ
	DCX	H
	SHLD	LOGPTR
LLOG:	LHLD	FCBLOG+33
	MOV	A,L
	ORA	H
	RZ
	DCX	H
	SHLD	FCBLOG+33
	RET
;
M015:	JMP	M023
;
PUTLOG:	PUSH	PSW
	LHLD	LOGLEN
	XCHG
	LHLD	LOGPTR
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	M029
	LXI	H,0
	SHLD	LOGPTR
M026:	XCHG
	LHLD	LOGLEN
	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JNC	M028
	LHLD	LOGADR
	DAD	D
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	LDA	FCBLOG+36
	CPI	0FFH
	JZ	M031
	MVI	C,USER
	MOV	E,A
	CALL	BDOS
M031:	LXI	D,FCBLOG
	MVI	C,WRDM
	CALL	BDOS
	CALL	RST$SYSTEM
	ORA	A
	JNZ	M027
	LHLD	FCBLOG+33
	INX	H
	SHLD	FCBLOG+33
	LXI	D,SECT
	LHLD	LOGPTR
	DAD	D
	SHLD	LOGPTR
	JMP	M026
;
M027:	CALL	ERXIT
	DB	CR,LF
	DB	'DISK FULL: LOG$'
;
M028:	LXI	D,DEFDMA
	MVI	C,SETDMA
	CALL	BDOS
	LXI	H,0
	SHLD	LOGPTR
M029:	XCHG
	LHLD	LOGADR
	DAD	D
	XCHG
	POP	PSW
	STAX	D
	LHLD	LOGPTR
	INX	H
	SHLD	LOGPTR
	RET
;
M023:	MVI	C,CFSIZE	;get file length
	LXI	D,FCBLOG
	CALL	BDOS
	CALL	LLOG
M030:	CALL	GETLOG
	CPI	EOF
	JNZ	M030
	CALL	BACKLOG
	CALL	RST$SYSTEM
	POP	PSW		;get option back
	CALL	PUTLOG
	CALL	SPEED		;get speed factor
	ADI	30H
	CALL	PUTLOG
	LDA	PGSIZE		;now the program size in minuntes..
	CALL	PNDEC		;..of transfer time
	MVI	A,' '           ;blank
	CALL	PUTLOG
;
; log the drive and user area as a prompt
;
	LDA	FCB
	ORA	A
	JNZ	WDRV
	MVI	C,CURDRV
	CALL	BDOS
	INR	A
WDRV:	ADI	'A'-1
	CALL	PUTLOG
	MVI	C,USER		;now the user area (as decimal number)
	MVI	E,0FFH
	CALL	BDOS
	CALL	PNDEC
	MVI	A,'>'           ;make it look like a prompt
	CALL	PUTLOG
	LDA	OPTSAV
	CPI	'L'
	JNZ	WDRV1
	LXI	H,MEMFCB	;name of file in lib
	MVI	B,11
	CALL	PUTSTR
	MVI	A,' '
	CALL	PUTLOG
WDRV1:	LXI	H,FCB+1 	;now the name of the file
	MVI	B,11
	CALL	PUTSTR
	LDA	OPTSAV
	CPI	'L'
	JNZ	WDRV2
	MVI	C,1
	JMP	SPLOOP
;
WDRV2:	MVI	C,13
SPLOOP:	PUSH	B
	MVI	A,' '
	CALL	PUTLOG
	POP	B
	DCR	C
	JNZ	SPLOOP
CLOOP:	CALL	GETCLLR	;and the caller
	CPI	EOF
	JZ	QUIT
	CPI	CR		;do not print 2nd line of 'lastcalr'
	JNZ	CLOP1
	CALL	PUTLOG
	MVI	A,LF
	CALL	PUTLOG		;and add a lf
	JMP	QUIT
;
CLOP1:	CPI	','             ;do not print the ',' between names
	JNZ	CLOP2
	MVI	A,' '           ;instead send a ' '
CLOP2:	CALL	PUTLOG
	JMP	CLOOP
;
PNDEC:	CPI	10		;two column decimal format routine
	JC	ONE		;one or two digits to area number?
	JMP	TWO
;
ONE:	PUSH	PSW
	MVI	A,'0'
	CALL	PUTLOG
	POP	PSW
TWO:	MVI	H,0
	MOV	L,A
DECOT:	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10
	LXI	D,-1
DECOT2:	DAD	B
	INX	D
	JC	DECOT2
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOT
	MOV	A,E
	ADI	'0'
	CALL	PUTLOG
	POP	H
	POP	D
	POP	B
	RET
;
PUTSTR:	MOV	A,M
	PUSH	H
	PUSH	B
	CALL	PUTLOG
	POP	B
	POP	H
	INX	H
	DCR	B
	JNZ	PUTSTR
	RET
;
QUIT:
M033:	LHLD	LOGPTR
	MOV	A,L
	ANI	(SECT-1) AND 0FFH
	JNZ	M034
	SHLD	LOGLEN
M034:	MVI	A,EOF
	PUSH	PSW
	CALL	PUTLOG
	POP	PSW
	JNZ	M033
	LDA	FCBLOG+36
	CPI	0FFH
	JZ	M037
	MVI	C,USER
	MOV	E,A
	CALL	BDOS
;
M037:	LXI	D,FCBLOG
	MVI	C,CLOSE
	CALL	BDOS
	CALL	RST$SYSTEM
	INR	A
	JNZ	EXIT
	CALL	ERXIT
	DB	CR,LF
	DB	'CANNOT CLOSE LOG$'
	 ENDIF			;LGCL
;
;		    end of LGCL routine
;***********************************************************************
;
;			CRC SUBROUTINES
;
;***********************************************************************
;
CLRCRC:	PUSH	H		;reset 'CRC' store for a new message
	LXI	H,0
	SHLD	CRCVAL
	POP	H
	RET
;
UPDCRC:	PUSH	PSW		;update 'CRC' store  with byte in 'A'
	PUSH	B
	PUSH	H
	MVI	B,8
	MOV	C,A
	LHLD	CRCVAL
UPDLOOP:MOV	A,C
	RLC
	MOV	C,A
	MOV	A,L
	RAL
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	JNC	SKIPIT
	MOV	A,H		;the generator is x^16 + x^12 + x^5 + 1
	XRI	10H
	MOV	H,A
	MOV	A,L
	XRI	21H
	MOV	L,A
SKIPIT:	DCR	B
	JNZ	UPDLOOP
	SHLD	CRCVAL
	POP	H
	POP	B
	POP	PSW
	RET
;
FINCRC:	PUSH	PSW		;finish 'CRC' calculation for final xmsn
	XRA	A
	CALL	UPDCRC
	CALL	UPDCRC
	PUSH	H
	LHLD	CRCVAL
	MOV	D,H
	MOV	E,L
	POP	H
	POP	PSW
	RET
;
CHKCRC:	PUSH	H		;check 'CRC' bytes of received message
	LHLD	CRCVAL
	MOV	A,H
	ORA	L
	POP	H
	RZ
	MVI	A,0FFH
	RET
;
	dseg
;
;***********************************************************************
;
; Temporary storage area
;
aclvl:	db	0
MEMFCB:	DB	'                '  ;library name (16 bytes required)
CONONL:	DB	0		;ctype console-only flag
CRCFLG:	DB	0		;sets to 'C' if checksum requested
CRCVAL:	DB	0,0		;current crc value
DIRSZ:	DB	0,0		;directory size
DUD:	DB	0		;specified disk
DUSAVE:	DB	0,0,0,0 	;buffer for drive/user
DUU:	DB	0		;specified user
ERRCDE:	DB	0		;receive error code
ERRCT:	DB	0		;error count
FRSTIM:	DB	0		;turned on after first 'SOH' received
INDEX:	DB	0,0		;index into directory
MAXEXT:	DB	0		;highest ext. # seen in file size calc.
RCNT:	DB	0,0		;record count
RCVRNO:	DB	0		;record number received
RECDNO:	DB	0,0		;current record number
OLDDRV:	DB	0		;save the original drive number
OLDUSR:	DB	0		;save the original user number
OPTSAV:	DB	0		;save option here for carrier loss
PRVTFL:	DB	0		;private user area option flag
SAVEHL:	DB	0,0		;saves defdma command line address
XDRV:	DB	DRV
XPRDRV:	DB	PRDRV
XUSR:	DB	USR
XPRUSR:	DB	PRUSR
;
; Following 3 used by disk buffering routines
;
EOFLG:	DB	0		;'EOF' flag (1=yes)
RECPTR:	DW	DBUF
RECNBF:	DW	0		;number of records in the buffer
	DS	60		;stack area
STACK:	DS	2		;save original stack address
;
; 16 record disk buffer
;
DBUF:	DS	0		;16 record disk buffer
LOGBUF:	EQU	DBUF+128	;for use with LGCL
;
; BDOS equates
;
WRCON:	EQU	2
PRINTF:	EQU	9
VERNO:	EQU	12		;get CP/M version number
SELDRV:	EQU	14		;select drive
OPEN:	EQU	15		;0ffh = not found
CLOSE:	EQU	16		;	"	"
SRCHF:	EQU	17		;	"	"
SRCHN:	EQU	18		;	"	"
ERASEF:	EQU	19		;no ret code
READ:	EQU	20		;0=ok, 1=eof
WRITE:	EQU	21		;0=ok, 1=err, 2=?, 0ffh=no dir spc
MAKE:	EQU	22		;0ffh=bad
CURDRV:	EQU	25		;get current drive
SETDMA:	EQU	26		;set dma
USER:	EQU	32		;set user area to receive file
RRDM:	EQU	33		;read random
WRDM:	EQU	34		;write random
CFSIZE:	EQU	35		;compute file size
SETRRD:	EQU	36		;set random record
BDOS:	EQU	BASE+05H
DEFDMA:	EQU	BASE+80H	;default dma address
FCB:	EQU	BASE+5CH	;system fcb
FCB1:	EQU	BASE+6CH	;second fcb
FCBEXT:	EQU	FCB+12		;file extent
FCBRNO:	EQU	FCB+32		;record number
RANDOM:	EQU	FCB+33		;random record field
;
	END