;
;	TITLE	'XMODEM ver. 12.5 - 07/13/86'
;
;	XMDM125.ASM - REMOTE CP/M FILE TRANSFER PROGRAM
;
;	Originally adapted from Ward Christensen's MODEM2
;		    by Keith Petersen, W8SDZ
;
;	ASEG		;Needed by M80 assemblers, comment out if using MAC
;
; This program allows a remote user to transfer files (to or from) RCPM
; systems running under BYE (remote console program).  It can be assem-
; bled with ASM, LASM, MAC, M80, SRLMAC and other 8080 assemblers.
;
; All comments and past revisions have been removed from this file and
; put into the XMODEM.UPD file.  Place only the current revision at the
; beginning of this file and move the one that was here to XMODEM.UPD.
;
;=======================================================================
;
;  v12.5	Fixed conditional assembly bug which caused date to
;  07/13/86	appear in log twice when MBBS and BYEBDOS were both set
;		to YES.
;		Fixed conditional assembly bug which did not allow MBFMSG
;		to be set to YES while MBDESC was set to NO.
;		Removed patch to log download before sending EOF because
;		EOF would not be sent, leaving caller's program in file
;		transfer mode, if LOGCALL routine exited with an error.
;		This problem was noticed by Keith Petersen.
;		Modified to abort any download which would result in a
;		user exceeding his time limit when BYEBDOS is YES.
;		Fixed bug which would cause caller to be logged off
;		without updating log file if transmission errors caused
;		his download to put him over time limit when BYEBDOS was
;		YES and CLOCK and TIMEON in BYE were YES (call to TCHECK
;		in BYE's extended BDOS call would hang up on caller).
;		Revised comments for some equates to make them easier to
;		understand.
;						- Murray Simsolo
;
;========================================================================
;
VERSION	EQU	1
INTERM	EQU	2
MODLEV	EQU	5
VMONTH	EQU	07
VDAY	EQU	13
VYEAR	EQU	86
;
NO	EQU	0
YES	EQU	NOT NO
;
; Define ASCII characters used
;
BS	EQU	08H	; Backspace character
ACK	EQU	06H	; Acknowledge
CAN	EQU	18H	; CTL-X for cancel
CR	EQU	0DH	; Carriage return
CRC	EQU	'C'	; CRC request character
EOF	EQU	1AH	; End of file - ^Z
EOT	EQU	04H	; End of transmission
LF	EQU	0AH	; Line feed
NAK	EQU	15H	; Negative acknowledge
RLEN	EQU	128	; Record length
TAB	EQU	09H	; Horizontal tab
SOH	EQU	01H	; Start of header for 128-byte blocks
STX	EQU	02H	; 'Start of header' for 1024 byte blocks
;
;=======================================================================
;
; Conditional equates - change to suit your system, then assemble
;
MHZ	EQU	4	; Clock speed, use integer (2,4,5,8, etc.)
CPM3	EQU	NO	; Yes, if operating in CP/M v3.0 environment
STOPBIT	EQU	NO	; No, if using 1 stop bit, yes if using 2
BYEBDOS	EQU	NO	; Yes, if using BYE338-up, BYE501-up, or NUBYE
			; with its I/O (CLOCK in BYE must be YES)
			; No if using your own hardware overlay
LUXMOD	EQU	NO	; Set to YES if LUXMODEM version desired rather
			; than standard XMODEM with upload options.
;
;=======================================================================
;
; If OK2400 is YES, then it overrides the TAGLBR and MAXMIN restrictions
; if the current caller is operating at 2400 baud (or higher).
;
OK2400	EQU	NO	; Yes, no restrictions for 2400 bps callers
;
MSPEED	EQU	3CH	; Location of speed byte set by BYE prgm, must
			; be set for OK2400 or BYEBDOS to work
;
DSPFNAM	EQU	YES	; Set to YES if you wish XMODEM to display the
			; file name being up or downloaded for user to
			; see and verify system received name correctly.
;
; If ZCPR3 is YES, then NO filetypes of .NDR or .RCP will be received.
; This is for security if you need LDR.COM on A0: for cold starts or if
; LDR is in the defined path. (If you don't have LDR on-line or
; accessible, then this equate isn't necessary for ZCPR3 systems.)
;
ZCPR3	EQU	NO	; Yes, NO filetypes .NDR or .RCP received
;
;=======================================================================
;
; If ZCPR2 = yes, then the following will all be NO if wheel is set
; in local non-zero (0FFH) mode.  SYSOP rules...
;
ZCPR2	EQU	NO	; Yes, if using ZCPR* with WHEEL byte
;
WHEEL	EQU	3EH	; Location of wheel byte (normally 3EH)
NOCOMR	EQU	YES	; Yes, change .COM to .OBJ on receive
NOCOMS	EQU	YES	; Yes, .COM files not sent
NOLBS	EQU	NO	; Yes, .??# files not sent
NOSYS	EQU	YES	; Yes, no $SYS files sent or reported
;
;=======================================================================
;
; The following are only used by NZCPR or ZCMD systems
;
USEMAX	EQU	NO	; Yes, using NZCPR for maximum du: values
			; No, use MAXDRV and MAXUSR specified next
DRIVMAX	EQU	03DH	; Location of MAXDRIV byte
USRMAX	EQU	03FH	; Location of MAXUSER byte
;
;=======================================================================
;
; Hard-coded system maximums allowed if USEMAX above is NO
;
MAXDRV	EQU	4	; Number of disk drives used (1=A, 2=B, etc)
MAXUSR	EQU	5	; Maximum 'SEND' user allowed
;
;=======================================================================
;
; File transfer buffer size - 16k is the same buffer length used in IMP,
; MDM7 and MEX so all those modem programs as well as XMODEM would be
; transferring from the buffer simultaneously, minimizing any delays.
; Slower floppy disk drives may require the use of a smaller buffer, try
; 8k, 4k, or 2k and use largest that does not result in a time-out at
; the sending end.  Please note the requirement for the protocol to ac-
; cept any mixture of 1K and small blocks may result in effective buffer
; usage extending an additional 896 bytes (7*128) beyond the 'end' of
; the buffer defined here. (Actually, due to handshaking, the buffers
; are NOT loaded simultaneously, so the above statement is misleading,
; too large a buffer will slow things down if you have a slow disk
; drive.. Too small a buffer will really slow you down though, so
; stick with 16k...)
;
BUFSIZ	EQU	16	; File transfer buffer size in Kbytes (16k)
;
;=======================================================================
;
; DESCRIB is used to ask the uploader to give a description of the file
; he just uploaded.  If YES and ZCPR2 is YES and wheel is set, it does
; NOT ask for a description unless ASKSYS is set to YES.
; (If using on an MBBS v4.1 and up system, use MBDESC instead of
; this option.) (NDESC can be used with either DESCRIB or MBDESC.)
;
DESCRIB	EQU	NO	; Yes asks for a description of uploaded file
DRIVE	EQU	'A'	; Drive area for description of upload
USER	EQU	14	; User area for description of upload
BSIZE	EQU	32*1024	; Set for 16k, 24k or 32k as desired for DESCRIB
;
NDESC	EQU	NO	; If YES, user can add a "N" to option to skip
			; description for pre-arranged uploads or
			; for the sysop..
ASKSYS	EQU	NO	; If YES, and ZCPR2=YES, the system will ask
			; the sysop for a description of the uploaded
			; file
ASKIND EQU	NO	; IF YES, user is asked for the category of
			; the uploaded file. This category is auto-
			; matically added to the file description.
;
;=======================================================================
;
; XMODEM transfer log options
;
LOGCAL	EQU	YES	; Yes, logs XMODEM transfers
LOGDRV	EQU	'A'	; Drive to place 'XMODEM.LOG' file
LOGUSR	EQU	14	; User area to put 'XMODEM.LOG' file
;
; OxGate BBS puts the date after the caller's name.  If you are using
; either BYEBDOS or B3RTC or RTC, and have an OxGate, then set this
; equate to YES, so the date doesn't appear twice.
;
OXGATE	EQU	NO	; If yes, and B3RTC or RTC is yes, does not read
			; date in OxGate's LASTCALR file.
;
KNET	EQU	NO	; If yes, the log file is called XMODEM.TX# with
			; $SYS attr set (for K-NET 84(tm) RCP/M Systems)
;
LASTDRV	EQU	'A'	; Drive to read 'LASTCALR' file from
LASTUSR	EQU	14	; User area of 'LASTCALR' file, if 'LOGCAL' 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.
;
RETRY	EQU	NO	; Yes requires a valid NAK to resend a record
			; No resends a record after any non-ACK
;
; Note that some modem programs will send a "C" instead of a NAK when
; operating in CRC mode. Therefore, RETRY EQU NO will allow XMODEM to
; work correctly with more programs.
;
;=======================================================================
;
; When sending in 1K block mode, XMODEM will downshift to 128 byte
; blocks when the ratio of successfully transmitted blocks to total
; errors falls below the ratio defined here.
;
DWNSHFT	EQU	5	; must have at least this many good blocks for
			; every error, or will downshift to size 128
;
MINKSP	EQU	5	; set this equate to the minimum MSPEED value
			; allowed to use the 1k block protocol..
;
; MSPEED values: 1=300, 5=1200, 6=2400
;
;=======================================================================
;
; Allows uploading to be done on a specified driver and user area so all
; can readily find the latest entries.
;
SETAREA	EQU	YES	; Yes, using designated du: to receive files
			; No, upload to currently logged du:
SPCDU	EQU	YES	; Yes, upload to designated du: if wheel set
;
DRV	EQU	'B'	; Drive to receive file on
USR	EQU	0	; User area to receive file in
;
ASKAREA	EQU	NO	; If YES, ask user what type of upload and
			; set area accordingly. For Multiple
			; Operating system support.
;
SYSNEW	EQU	NO	; If YES, then new uploads are made $SYS
			; to "hide" them from users until cleared...
;
;=======================================================================
;
; Selects the DU: for uploading private files with XMODEM RP option.
;
PRDRV	EQU	'B'	; Private drive for SYSOP to receive file
PRUSR	EQU	14	; Private user area for SYSOP to receive file
;
;=======================================================================
;
; Selects the DU: for private download files.  This permits Sysop
; to put file(s) in this area, then leave a private note to that
; person mentioning the name(s) of the file and its location.
;
SPLDRV	EQU	'B'	; Special drive area for downloading SYSOP files
SPLUSR	EQU	14	; Special user area for downloading SYSOP files
;
;=======================================================================
;
; Selects the DU: used for message files uploaded with the "RM" option.
; (Used only if MBFMSG option enabled)
;
MSGDRV	EQU	'A'	; Drive used to receive message files
MSGUSR	EQU	15	; User used to receive message files
;
;=======================================================================
;
; SYSOP may use NSWP or TAG and set the high bit of F1 to disallow the
; sending of large .LBR files.	If TAGLBR is YES, only LUX or the option
; XMODEM L will allow transfer of individual member files from tagged
; .LBR files.  The entire .LBR file can NOT be sent using XMODEM S NAME.
;
TAGLBR	EQU	NO	; Yes tagged .LBR files not sent
;
; Note: The OK2400 equate if YES will bypass this restriction if the
;	caller is operating at 2400 baud (or faster).
;
;=======================================================================
;
; Some modems will either go onhook immediately after carrier loss or
; can be set to lower values.  A good value with the Smartmodem is five
; 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	2	; Seconds to abort after carrier loss
;
;=======================================================================
;
; Count the number of up/down loads since login.  Your BBS program can
; check UPLDS and NDLDS when user logs out and update either the users
; file or another file for this purpose.
;
LOGLDS	EQU	NO	; Count number of up/down loads since login.
;
	 IF	LOGLDS
UPLDS	EQU	054H	; Clear these values to Zero from your BBS pro-
DNLDS	EQU	055H	;   gram when somebody logs in.  NOTE:	Clear
			;   ONLY when a user logs in.  Not when he re-
			;   enters the BBS program for CP/M.
	 ENDIF
;
;======================================================================
;
; Maximum file transfer time allowed.
;
; NOTE: If ZCPR2 = YES and WHEEL byte is set, send time is unlimited.
;
;		 TIME	300 BPS  1200 BPS
;		------	-------  --------
;		30 min	 48.7k	   180k
;		45 min	 73.1k	   270k
;		60 min	 97.5k	   360k
;
MAXTIM	EQU	YES	; Yes if limiting transmission time
;
MAXMIN	EQU	60	; Minutes for maximum file transfer time.
			;   this should be set to 60 if TIMEON is YES
			;   (99 minutes maximum.) (This is ignored if
			;   BYEBDOS is set.)
;
; Note: The OK2400 equate if YES will bypass MAXMIN limits.
;
;======================================================================
;
; The following equates need to be set ONLY if you are NOT using the
; BYE-BDOS calls supported in BYE338 and newer.
;
; 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 (bytes) here
;
;=======================================================================
;
; USECON allows XMODEM to display the record count on the local CRT
; during transfers.  All new remote console programs support this
; feature.  BYE3* and MBYE3* will tell XMODEM where to find the local
; console's output vector.
;
USECON	EQU	YES	; Yes to get CONOUT address from BYE
			; NO, get CONOUT address from the XMODEM overlay
;
CONOFF	EQU	15	; Offset to COVECT where original console output
			;   routine address is stored in BYE3/MBYE
			;   versions immediately followed by BYE as a
			;   check to insure BYE is running.
;
;=======================================================================
;		    start of TIMEON area
;
RTC	EQU	NO	; If YES, add clock and date reader code at
			; start of GETTIME: and GETDATE: below
;
; The TIMEON and RTC equates should be NO if B3RTC is YES
;
TIMEON	EQU	NO	; If YES and BYEBDOS is NO, add your clock reader
			; code at the start of label GETTIME: and return
			; time in registers A & B.  Also set to YES if
			; BYEBDOS is YES and you want XMODEM to check
			; time on system (not necessary if TIMEON in BYE
			; is YES - saves unnecessary code).
TOSEXIT	EQU	NO	; If YES, time on system displayed on exit if
			; B3RTC or TIMEON or BYEBDOS set to YES
;
	 IF	TIMEON AND NOT CPM3
LHOUR	EQU	050H	; Set by BBS (or BYE) in binary when user logs
LMIN	EQU	051H	; on and his status
STATUS	EQU	053H
	 ENDIF
;
	 IF	TIMEON AND CPM3
LHOUR	EQU	022H	; Set by BBS (or BYE) in binary when user logs
LMIN	EQU	023H	; on and his status
STATUS	EQU	024H
	 ENDIF
;
;		   end of TIMEON area
;========================================================================
;		   Miscellaneous Support Bytes
;========================================================================
; Set this equate to enable access byte support.  ACBOFF specifies
; the offset from the JMP COLDBOOT instruction as above with WRTLOC.
; MBBS and some newer BBS's support this byte, therefore, it is no
; longer specific to MBBS. You must determine if your system uses this.
;
ACCESS	EQU	NO	; Yes, check flags for upload/dwnld restrictions
ACBOFF	EQU	21	; # of bytes from JMP COLDBOOT to ACCESS byte.
ACWRIT	EQU	8	; Bit to test for BBS msg write OK (1=OK,0=NOT OK)
ACDNLD	EQU	32	; Bit to test for downloads OK (1=OK,0=NOT OK)
ACUPLD	EQU	64	; Bit to test for uploads OK (1=OK,0=NOT OK)
DWNTAG	EQU	NO	; If YES, files with F3 attribute bit can be
			; downloaded regardless of access byte restrictions
;
; Access byte flag bit assignments
;
;	Bit	; Used for
;	0	; System access (no admittance if off)
;	1	; BBS access (if off, dumped to CP/M)
;	2	; Read access (if off, no "R" command allowed)
;	3	; Write access (if off, no "E" command allowed)
;	4	; CP/M access (if off, no admittance to CP/M)
;	5	; Download access (if off, no downloads permitted)
;	6	; Upload access (if off, no uploads permitted)
;	7	; Privileged user (if on, user is "privileged")
;
; Of these bits, only 5 and 6 are used by XMODEM.  Bit numbers are
; powers of 2, bit 0 being least significant bit of byte.
;-------------------------------------------------------------------------
; The CONFUN and WRTLOC are supported by BYE339 and many BBS's require
; the WRTLOC for propoer operation. These functions are not specific to
; MBBS and therefore have been made independant of the MBBS equate.
;
; (Set CONFUN/WRTLOC YES if using with MBBS)
;
CONFUN	EQU	YES	; Yes, check local console for function keys
SYSABT	EQU	YES	; If yes, sysop can abort up/downloads with ^X
			; (CONFUN must be enabled to use this option)
;
; If you set CONFUN true, a call to the console status check routine in
; the BIOS will be done during waiting periods and when sector counts
; are displayed on the local console in order to allow MBYE and BYE339
; function keys to work.  This is for MBYE.  Other versions of BYE3
; may or may not check for console function keys during the console
; status check "MSTAT" routine.
;
WRTLOC	EQU	YES	; Yes, set/reset WRTLOC so BYE won't hang up
LOCOFF	EQU	12	; # of bytes from JMP COLDBOOT to WRTLOC byte
;
; NOTE: Code to set/reset WRTLOC assumes WRTLOC byte to be
;	located "LOCOFF" bytes from the JMP COLDBOOT instruction at
;	the beginning of the BYE3 BIOS jump table. On BYE3 versions
;	and MBYE versions, this offset is usually 12. Note:
;	TIMEON and RTC should be set to no if B3RTC is on.
;	(If BYEBDOS is enabled, the appropriate extended BDOS
;	calls are used to set and reset the WRTLOC if this
;	equate is set and LOCOFF is ignored in these cases.)
;
;		   End of Miscellaneous Support Bytes
;=======================================================================
;		start of MBBS/MBYE specific information
;
B3RTC	EQU	NO	; If YES, your clock is setup in BYE3 (or MBYE)
			; set to NO if using BYEBDOS
B3COFF	EQU	25	; OFFSET from COLDBOOT: to RTCBUF address
B3CMOS	EQU	7	; OFFSET from RTCBUF: to mins on system
;
MBMXT	EQU	NO	; If YES, running MBYE with max. time on system
MBMXO	EQU	24	; OFFSET from COLDBOOT: to MXML address
;
; If B3RTC is YES and LOGCAL is YES, the log file will show
; the date and time of all up/downloads.  Note: Set RTC, TIMEON,
; and BYEBDOS to NO if using B3RTC or MBMXT.
;
; Note: Some of these equates may not be valid if you are using MBYE*
;	with another BBS program - check them carefully.
;
MBBS	EQU	NO	; Yes if running MBBS v2.9 up
LOGSYS	EQU	NO	; Set YES if running MBBS v3.1 or earlier
MBDESC	EQU	NO	; Yes if running MBBS v4.0 up for upload desc.
NEWPRV	EQU	NO	; Yes: all new uploads are private initially
MBFMSG	EQU	NO	; Yes if running MBYE v4.1 up with MFMSG
;
;
;----------------------------------------------------------------------
;
; If B3RTC is YES download time may be limited using the following
; equates instead of using MAXMIN.  MAXMIN will be the default value
; if BYE is not running.
;
B3TOS	EQU	NO	; Yes if using BYE3/MBYE and want to show time on sys
;
MTOS	EQU	NO	; Yes if using maximum time on system instead
			;   of MAXMIN to limit transmission time
;
	 IF	MTOS AND MBMXT	; both must be YES
MXTOS	EQU	YES	; (leave YES)
	 ENDIF
;
	 IF	NOT (MTOS AND MBMXT) ; (if either is NO)
MXTOS	EQU	NO	; (leave NO)
	 ENDIF
;
MXTL	EQU	NO	; Yes if limiting transmission time to time
			;   left plus MAXMIN. MXTOS must be yes.
;
	 IF	MXTL AND MXTOS	; both must be YES
MTL	EQU	YES	; (leave YES)
	 ENDIF
;
	 IF	NOT (MXTL AND MXTOS); (if either are NO)
MTL	EQU	NO	; (leave NO)
	 ENDIF
;
;		end of MBBS/MBYE specific information
;=======================================================================
;
	ORG	100H
	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.
;
	 IF	NOT BYEBDOS	; Universal I/O
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 character from modem
RCVRDY:	JMP	0		; Check receive ready (A - ERRCDE)
SNDRDY:	JMP	0		; Check send ready
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
	 ENDIF
;
;-----------------------------------------------------------------------
;
	 IF	NOT (LARGEIO OR	BYEBDOS)
	ORG	100H+80H	; Origin plus 128 bytes for patches
	 ENDIF
;
	 IF	LARGEIO	AND NOT	BYEBDOS
	ORG	100H+LARSIZE	; I/O patch area size if over 128 bytes
	 ENDIF
;
; PRIVATE/SETAREA UPLOAD DISK/USER AREAS:
;
; (Here at start (usually 180H unless LARGEIO) so can be easily patched
; in .COM file using DDT without needing to reassemble.  All references
; are made to these locations in memory and not to DRV/PRDRV/USR/PRUSR
; equates directly.)
;
XPRDRV:	DB	PRDRV		; Private uploads go to this disk/user
XPRUSR:	DB	PRUSR
;
XDRV:	DB	DRV		; Forced uploads (if SETAREA EQU YES)
XUSR:	DB	USR		; Go to this disk/user
;
	 IF	MBFMSG
XMDRV:	DB	MSGDRV		; Message uploads go to this disk/user
XMUSR:	DB	MSGUSR		; (if MBFMSG option enabled)
	 ENDIF
;
;-----------------------------------------------------------------------
;
; File descriptors, change as desired if this list is not suitable.
; Move the line with the terminating '$' up, if fewer descriptors are
; desired.
;
	IF	ASKIND AND DESCRIB
;
KIND0:	DB	'  0) - CP/M',CR,LF
KIND1:	DB	'  1) - ZCPR',CR,LF
KIND2:	DB	'  2) - MS-DOS/PC-DOS',CR,LF
KIND3:	DB	'  3) - dBASE',CR,LF
KIND4:	DB	'  4) - Basic',CR,LF
KIND5:	DB	'  5) - General',CR,LF
KIND6:	DB	'  6) - Modems',CR,LF
KIND7:	DB	'  7) - Games',CR,LF
KIND8:	DB	'  8) - Xerox/KPro',CR,LF
KIND9:	DB	'  9) - RCP/M',CR,LF
	DB	'$'
	ENDIF
;.....
;
;----------------------------------------------------------------------
;
; If ASKAREA and SETAREA are set, then set these areas up and modify
; the message text in the FILTYP: function below if you desire a
; different choice. (As released in XMDM121, 1 = CP/M, 2 = MS/PC-DOS
; and 3 = General Interest.)
;
	 IF	ASKAREA	AND SETAREA
;
MAXTYP	EQU	'3'		; Set maximum type choice # here
;
TYPTBL:	DB	'B',0		; CHOICE 1 (CP/M NORMAL)
	DB	'B',9		; CHOICE 1 (CP/M PRIVATE)
	DB	'B',3		; CHOICE 2 (MS/PC-DOS NORMAL)
	DB	'B',9		; CHOICE 2 (MS/PC-DOS PRIVATE)
	DB	'B',0		; CHOICE 3 (General interest NORMAL)
	DB	'B',9		; CHOICE 3 (General interest PRIVATE)
;
	 ENDIF
;
;=======================================================================
;
;			PROGRAM STARTS HERE
;
;=======================================================================
;
; Save CP/M stack, initialize new one for this program
;
BEGIN:	LXI	H,0
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK	; Initialize new stack
;
	 IF	BYEBDOS
	CALL	BYECHK
	JZ	BYEOK
	CALL	ILPRT
	DB	'You need to be running BYEBDOS',CR,LF,0
	JMP	EXIT2		; Get stack pointer back and return
;
BYEOK:	MVI	C,BDSTOS	; Get current maximum time on system
	MVI	E,255
	CALL	BDOS
	STA	MAXTOS
	 ENDIF
;
	 IF	B3RTC AND MXTOS	AND (NOT BYEBDOS)
	CALL	BYECHK		; If BYE not active
	MVI	A,MAXMIN	; (we'll use MAXMIN as default)
	JNZ	EXTMXT		; Skip MXML update
	LHLD	0001H		; Get JMP COLDBOOT
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,MBMXO		; + MBMXO offset to MXML
	DAD	D
	MOV	A,M		; = max time allowed on system
;
EXTMXT:	STA	MAXTOS		; Store max download time
	 ENDIF
;
; Get address of RTCBUF in BYE3 or MBYE
;
	 IF	B3RTC AND (NOT BYEBDOS)
	CALL	BYECHK		; See if BYE3/MBYE is running
	JNZ	NOBYE0		; If not, skip this junk
	LHLD	0001H		; Get COLDBOOT addr
	DCX	H		; (just before JMP WBOOT)
	MOV	D,M		; And stuff in DE
	DCX	H
	MOV	E,M
	LXI	H,B3COFF	; Add offset to RTCBUF address
	DAD	D		; (in HL)
	MOV	E,M		; Get RTCBUF address
	INX	H		; And
	MOV	D,M		; Stuff in DE
	XCHG			; Swap into HL
	SHLD	RTCBUF		; Save for use later
	 ENDIF
;
NOBYE0:	 IF	CONFUN		; Console status checks to be done?
	LHLD	0001H		; If so get addr of warmboot (jmp table)
	INX	H
	INX	H
	INX	H		; + 3 = address of console status check
	SHLD	CONCHK+1	; Stuff after call for FUNCHK
	 ENDIF
;
	 IF	WRTLOC		; Set WRITE LOCK?
	CALL	SETLCK
	 ENDIF
;
; Save the current drive and user area
;
NOBYE1:	MVI	E,0FFH		; Get the current user area
	MVI	C,SETUSR
	CALL	BDOS
	STA	OLDUSR		; Save user number here
	MVI	C,CURDRV	; Get the current drive
	CALL	BDOS
	STA	OLDDRV		; Save drive here
;
	 IF	B3TOS OR TIMEON
	CALL	TIME		; Get user's time status
	 ENDIF
;
	 IF	BYEBDOS	AND (NOT TIMEON)
	MVI	C,BDPTOS	; Display time on system and
	CALL	BDOS		; log off if over time limit
	 ENDIF
;
	CALL	ILPRT
	DB	CR,LF
;
	 IF	LUXMOD
	DB	'LUX-'
	 ENDIF
;
	DB	'XMODEM v'
	DB	VERSION+'0',INTERM+'0','.',MODLEV+'0',' - '
	DB	VMONTH/10+'0',VMONTH MOD 10+'0','/'
	DB	VDAY/10+'0',VDAY MOD 10+'0','/'
	DB	VYEAR/10+'0',VYEAR MOD 10+'0',CR,LF,0
;
; Stuff address of BIOS CONOUT vector in our routine as default.
;
	 IF	USECON AND NOT BYEBDOS
	LHLD	0001H		; Point to warm boot for normal BIOS
	LXI	D,9
	DAD	D		; Calc addr of normal BIOS conout vector
	SHLD	CONOUT+1	; Save in case no BYE program is active
	CALL	BYECHK
	JNZ	NOBYE
	XCHG			; Point to the console output routine
	SHLD	CONOUT+1	; Save vector address supplied by BYE
	 ENDIF
;
; Get option
;
NOBYE:	LXI	H,FCB+1		; Get primary option
	MOV	A,M
	STA	OPTSAV		; Save option
	CPI	'R'		; Receive file?
	JZ	RECVOPT
;
; Send option processor
; Single option: "K"	- force 1k mode
;
	INX	H		; Look for a 'K'
	MOV	A,M
	CPI	' '		; Is it a space?
	JZ	ALLSET		; Then we're ready to send...
	CPI	'K'
	JNZ	OPTERR		; "K" is the only setable 2nd option
	LDA	MSPEED
	CPI	MINKSP		; If less than MINKSP bps, ignore 1k
	JC	ALLSET		; Request
	MVI	A,'K'		; Set 1k mode
	STA	KFLAG		; First, force us to 1K mode
	CALL	ILPRT
	DB	'(1k protocol selected)',CR,LF,0
	JMP	ALLSET		; That's it for send...
;
; Receive option processor
; 3 or 4 options: "X"	- disable auto-protocol select
;		  "P"	- receive file in private area
;		  "C"	- force checksum protocol
;		  "M"	- message file upload (if MBFMSG)
;
RECVOPT:MVI	A,'K'		; First off, default to 1K mode
	STA	KFLAG
	MVI	A,0		; And default to CRC mode
	STA	CRCFLG
;
	CALL	RCVOPC		; Check 1st option
	CALL	RCVOPC		; Check 2nd option
	CALL	RCVOPC		; Check 3rd option
;
	 IF	MBFMSG
	CALL	RCVOPC		; Check 4th option
	 ENDIF
;
	 IF	NDESC
	CALL	RCVOPC		; Check 4th (or 5th) option
	 ENDIF
;
	JMP	OPTERR		; If 5th or 6th option, whoops!
;
RCVOPC:	INX	H		; Increment pointer to next character
	MOV	A,M		; Get option character HL points to
	CPI	' '		; Space?
	JNZ	CHK1ST		; No, we have an option
	POP	PSW		; Else, we are done (restore stack)
	JMP	ALLSET		; Exit routine now
;
CHK1ST:	CPI	'P'		; Got a "P" option?
	JNZ	CHK2ND		; Nope
	STA	PRVTFL		; Yep, set private upload flag
	RET			; Check next option
;
CHK2ND:	CPI	'C'		; Got a "C" option?
	JNZ	CHK3RD		; Nope
	STA	CRCFLG		; Set checksum flag (crc flag="C")
	CALL	ILPRT
	DB	'(Checksum protocol selected)',CR,LF,0
	RET
;
CHK3RD:	CPI	'X'		; Got an "X" for first option?
	JNZ	CHK4TH
	MVI	A,0
	STA	KFLAG		; Disable "1K" flag
	CALL	ILPRT
	DB	'(128 byte protocol only)',CR,LF,0
	RET
;
CHK4TH:
	 IF	MBFMSG		; Allowing "RM" for message uploads?
	CPI	'M'		; Got an "M" for message upload?
	JNZ	CHK5TH		; If not, bad option
	STA	MSGFLG		; If "M", set MSGFLG
	MVI	A,'P'		; Also, set PRVTFL
	STA	PRVTFL
	LDA	XMDRV		; And copy XMDRV
	STA	XPRDRV
	LDA	XMUSR		; And XMUSR to XPRDRV / XPRUSR
	STA	XPRUSR
	RET
	 ENDIF
;
CHK5TH:
	 IF	NDESC		; Allowing "RN" to skip upload descript?
	CPI	'N'		; Got an 'N'?
	JNZ	BADROP		; If nope, is NG..
	STA	NDSCFL		; else set flag to skip descript phase
	RET
	 ENDIF
;
BADROP:	POP	PSW		; Restore stack
	JMP	OPTERR		; is bad option
;
; All options have been set, gobble up garbage characters from the line
; prior to receive or send and initialize whatever has to be initialized
;
ALLSET:	CALL	GETCHR
	CALL	GETCHR
	CALL	MINIT
;
; Jump to appropriate function
;
	LDA	OPTSAV		; Get primary option again
;
	 IF	LOGCAL
	STA	LOGOPT		; But save it
	 ENDIF
;
	CPI	'L'		; To send a file from a library?
	JZ	SENDFIL
	CPI	'R'		; To receive a file?
	JZ	RCVFIL
	CPI	'S'
	JZ	SENDFIL		; Otherwise go send a file
;
; Invalid option
;
OPTERR:
;
	 IF	ASKAREA	AND SETAREA
	LDA	OPTSAV		; Check 'option'
	CPI	'A'		; If 'A' (avail upload space option)
	CZ	FILTYP		;   ask type of upload...
	 ENDIF
;
	 IF	NOT (SETAREA OR	LUXMOD)
	CALL	ILPRT
	DB	CR,LF,'Uploads files to specified or '
	DB	'current disk/user',0
	 ENDIF
;
	 IF	SETAREA	AND NOT	LUXMOD
	CALL	ILPRT
	DB	CR,LF,'Uploads files to ',0
	LDA	XDRV
	CALL	CTYPE
	LDA	XUSR
	MVI	H,0
	MOV	L,A
	CALL	DECOUT
	MVI	A,':'
	CALL	CTYPE
	CALL	ILPRT
	DB	' (',0
	LDA	XDRV
	STA	KDRV
	CALL	KSHOW
	MVI	A,')'
	CALL	CTYPE
	 ENDIF
;
	 IF	NOT LUXMOD
	CALL	ILPRT
	DB	CR,LF,'Private files to ',0
	LDA	XPRDRV
	CALL	CTYPE
	LDA	XPRUSR
	MVI	H,0
	MOV	L,A
	CALL	DECOUT
	MVI	A,':'
	CALL	CTYPE
	LDA	XPRDRV		; If private drive is
	MOV	B,A
	LDA	XDRV		; The same as forced upload drive
	SUB	B
	JZ	SKSK2		; Skip showing space available 2nd time
	CALL	ILPRT
	DB	' (',0
	LDA	XPRDRV		; Else show it..
	STA	KDRV
	CALL	KSHOW
	MVI	A,')'
	CALL	CTYPE
;
SKSK2:	CALL	ILPRT
	DB	CR,LF,0
	 ENDIF
;
	LDA	OPTSAV		; Check 'option'
	CPI	'A'		; If 'A' (avail upload space option)
	JZ	EXIT		; Skip error message
;
	 IF	WRTLOC AND NOT BYEBDOS
	CALL	RSTLCK
	 ENDIF
;
	CALL	ERXIT		; Exit with error
	DB	'++ Examples of valid options: ++ '
	DB	'(use Ctrl-C or Ctrl-K to abort)',CR,LF,LF
;
	 IF	NOT LUXMOD
	DB	'XMODEM S HELLO.DOC         send a file to you',CR,LF
	DB	'XMODEM S B1:HELLO.DOC      send from a named '
	DB	'drive/area',CR,LF
	DB	'XMODEM SK HELLO.DOC        send in 1k blocks',CR,LF
	DB	'XMODEM L CAT.LBR CAT.COM   send a file from a library'
	DB	CR,LF
	DB	'XMODEM LK CAT.LBR CAT.COM  send in 1k blocks',CR,LF
	DB	'   The ".LBR" file extension may be omitted',CR,LF,LF
	DB	'XMODEM R HELLO.DOC         receive a file from you'
	DB	CR,LF
	DB	'XMODEM RP HELLO.DOC        receive in a private area'
	DB	CR,LF
	 ENDIF
;
	 IF	(MBDESC	OR DESCRIB) AND	NDESC
	DB	'XMODEM RN FILE.EXT         receive without description'
	DB	CR,LF
	 ENDIF
;
	 IF	(NOT LUXMOD) AND MBFMSG
	DB	'XMODEM RM MESSAGE.FIL      receive message for MBBS'
	DB	CR,LF
	 ENDIF
;
	 IF	NOT LUXMOD
	DB	'   Add "C" for forced checksum ("RC" "RPC")',CR,LF
	DB	'   Add "X" for forced 128 byte protocol ("RX" "RPX")'
	DB	CR,LF
	DB	'   "R" switches from CRC to checksum after 5 retries'
	DB	CR,LF,LF
	DB	'XMODEM A                   shows areas/space for '
	DB	'uploads$'
	 ENDIF
;
	 IF	LUXMOD
	DB	'SEND MEMBERNAME.TYP        sends member with CRC'
	DB	CR,LF
	DB	'SENDK MEMBERNAME.TYP       sends using 1k packets'
	DB	CR,LF,LF
	DB	'XMODEM S MEMBERNAME.TYP    same as SEND command'
	DB	CR,LF
	DB	'XMODEM SK MEMBERNAME.TYP   same as SENDK',CR,LF,LF
	DB	'(XMODEM can NOT receive while in LUX.)$'
	 ENDIF
;
;
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
; ---> 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
	LHLD	RCNT		; XMDM116.FIX
	CALL	CKKSIZ		; XMDM116.FIX -- Murray Simsolo
;
SENDLP:	CALL	CHKERR		; Check ratio of blocks to errors
	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'
	CALL	UPDPTR		; Update buffer pointers and counters
	LDA	OPTSAV		; Get the command option again
	CPI	'L'
	JNZ	SENDLP		; If not library option, go ahead
;
;
; Check to see if done sending LBR member yet, downshift to small blocks
; if less that 8 remaining
;
	LHLD	RCNT
	MOV	A,H
	ORA	L		; See if L and H both zero now
	JZ	SENDEOF		; If finished, exit
	LDA	KFLAG		; Was last record a 1024 byte one?
	ORA	A
	JZ	SNRPT0		; Just handled an normal 128 byte record
	DCX	H		; Otherwise, must have be a BIG one, so
	DCX	H		; Seven ...
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	DCX	H		; Plus
;
SNRPT0:	DCX	H		; One, is either 1 or 8
	SHLD	RCNT		; One (or eight) less to go
	CALL	CKKSIZ		; Check to see if at least 8 left
	JMP	SENDLP		; Loop until EOF
;
; File sent, send EOT's
;
SENDEOF: IF	LOGLDS
	LDA	DNLDS		; Get Down loads Counter
	INR	A		; One more download since log in
	STA	DNLDS		; And update counter
	 ENDIF
;
SNDEOFL:LDA	EOFCTR		; Get EOF counter
	CPI	5		; Tried five times ?
	JZ	EXITLG		; Yes, quit trying
	MVI	A,EOT		; Send an 'EOT'
	CALL	SEND
	LDA	EOFCTR		; Get EOF counter
	INR	A		; Add one
	STA	EOFCTR		; Save new count
	CALL	GETACK		; Get the ACK
	JC	SNDEOFL		; 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 FILENAME.TYP".  Can be invoked by "XMODEM R FILENAME.TYPE"
; or by "XMODEM RC FILENAME.TYP" if checksum is to be used.
;
RCVFIL:	 IF	ACCESS
	CALL	BYECHK
	JNZ	RCVFL1
	LHLD	0001H		; Get JMP COLDBOOT
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,ACBOFF	; + ACBOFF
	DAD	D
	MOV	A,M		; = ACCESS byte address
	ANI	ACUPLD		; Test upload access bit
	JNZ	RCVFL0		; If bit on, uploads OK
	CALL	ERXIT
	DB	'Sorry, but you are not allowed to upload files '
	DB	'at this time...$'
	 ENDIF
;
RCVFL0:	 IF	ACCESS AND MBFMSG
	LDA	MSGFLG
	ORA	A		; Is this "RM" upload?
	JZ	RCVFL1		; If not, skip ACWRIT check
	MOV	A,M
	ANI	ACWRIT		; If "RM", check if WRITE access
	JNZ	RCVFL1		; If so, ok
	CALL	ERXIT
	DB	'Sorry, but you are not allowed to enter messages '
	DB	'at this time...$'
	 ENDIF
;
RCVFL1:
	CALL	LOGDU		; Check file name or drive/user option
;
	 IF	ZCPR2
	LDA	WHEEL		; Let SYSOP put file wherever he wants
	ORA	A
	JZ	RCVFL5		; If WHEEL byte not set, stay normal
	LDA	RCVDRV
	ORA	A
	 ENDIF
;
;
	 IF	ZCPR2 AND NOT SPCDU
	JZ	RCVFL2
	 ENDIF
;
	 IF	ZCPR2 AND SPCDU
	JZ	RCVFL2
	 ENDIF
;
	 IF	ZCPR2
	SUI	'A'		; Convert ASCII drive to binary
	JMP	RCVFL3
;
RCVFL2:	LDA	OLDDRV
;
RCVFL3:	INR	A
	STA	FCB
	ADI	'A'-1		; Convert binary to ASCII
	STA	XDRV		; Drive
	LDA	RCVDRV		; See if a drive was requested
	ORA	A
	LDA	OLDUSR		; Current user
	JZ	RCVFL4		; If not, use current user
	LDA	RCVUSR		; Else get requested user
;
RCVFL4:	STA	XUSR		; User
	JMP	CONTIN
	 ENDIF	; ZCPR2
;
RCVFL5:	 IF	SETAREA
	LDA	XDRV
	SUI	40H
	STA	FCB
	 ENDIF
;
	LDA	PRVTFL		; Receiving to a private area?
	ORA	A
	JZ	RCVFL6		; If not, exit
	LDA	XPRDRV		; Private area takes precedence
	SUI	40H
	STA	FCB		; Store drive to be used
;
RCVFL6:	 IF	NOCOMR
	LXI	H,FCB+9		; Point to filetype
	MVI	A,'C'		; 1st letter
	CMP	M		; Is it C ?
	JNZ	RCVFL7		; If not, continue normally
	INX	H		; Get 2nd letter
	MVI	A,'O'		; 2nd letter
	CMP	M		; Is it O ?
	JNZ	RCVFL7		; If not, continue normally
	INX	H		; Get 3rd letter
	MVI	A,'M'		; 3rd letter
	CMP	M		; Is it M ?
	JNZ	RCVFL7		; If not, continue normally
	CALL	ILPRT		; 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'
	JMP	CONTIN
	 ENDIF	; NOCOMR
;
RCVFL7:	 IF	NOCOMR AND CPM3
	LXI	H,FCB+9		; Point to filetype
	MVI	A,'P'		; 1st letter
	CMP	M		; Is it P ?
	JNZ	RCVFL8		; If not, continue normally
	INX	H		; Get 2nd letter
	MVI	A,'R'		; 2nd letter
	CMP	M		; Is it R ?
	JNZ	RCVFL8		; If not, continue normally
	INX	H		; Get 3rd letter
	MVI	A,'L'		; 3rd letter
	CMP	M		; Is it L ?
	JNZ	RCVFL8		; If not, continue normally
	CALL	ILPRT		; Print renaming message
	DB	'Auto-renaming file to ".OBP"',CR,LF,0
	LXI	H,FCB+9
	MVI	M,'O'
	INX	H
	MVI	M,'B'
	INX	H
	MVI	M,'P'
	JMP	CONTIN
	 ENDIF	; NOCOMR AND CPM3
;
; Check to see if filetype is .NDR, if so do NOT allow upload
;
RCVFL8:	 IF	ZCPR3
	LXI	H,FCB+9		; Point to filetype
	MVI	A,'N'		; 1st letter
	CMP	M		; Is it N ?
	JNZ	RCVFL9		; If not, continue normally
	INX	H		; Get 2nd letter
	MVI	A,'D'		; 2nd letter
	CMP	M		; Is it D ?
	JNZ	RCVFL9		; If not, continue normally
	INX	H		; Get 3rd letter
	MVI	A,'R'		; 3rd letter
	CMP	M		; Is it R ?
	JNZ	RCVFL9		; If not, continue normally
	CALL	ERXIT		; Print renaming message
	DB	'Cannot receive filetype ".NDR"',CR,LF,'$'
;
; Check to see if filetype is .RCP, if so do NOT allow upload
;
RCVFL9:	LXI	H,FCB+9		; Point to filetype
	MVI	A,'R'		; 1st letter
	CMP	M		; Is it R ?
	JNZ	CONTIN		; If not, continue normally
	INX	H		; Get 2nd letter
	MVI	A,'C'		; 2nd letter
	CMP	M		; Is it C ?
	JNZ	CONTIN		; If not, continue normally
	INX	H		; Get 3rd letter
	MVI	A,'P'		; 3rd letter
	CMP	M		; Is it P ?
	JNZ	CONTIN		; If not, continue normally
	CALL	ERXIT		; Abort with error msg
	DB	'Cannot receive filetype ".RCP"',CR,LF,'$'
	 ENDIF	; ZCPR3
;
CONTIN:
	 IF	MBFMSG
	LDA	MSGFLG
	ORA	A		; Is this "RM" upload?
	JNZ	DONT		; If yes, skip asking what kind of upload
	 ENDIF
;
	 IF	ASKAREA	AND SETAREA AND	(NOT ZCPR2)
	CALL	FILTYP		; Ask caller what kinda beast it is
	 ENDIF
;
	 IF	ASKAREA	AND SETAREA AND	ZCPR2
	LDA	WHEEL		; Don't ask the SYSOP
	ORA	A
	JNZ	DONT		; If WHEEL byte set, skip asking
	CALL	FILTYP		; Ask caller what kinda beast it is
	 ENDIF
;
DONT:	CALL	ILPRT		; Print the message
;
	 IF	NOT DSPFNAM
	DB	CR,LF,'File will be received on ',0
	 ENDIF
;
	 IF	DSPFNAM
	DB	CR,LF,'Receiving: ',0
	 ENDIF
;
	LDA	PRVTFL		; Going to store in the private area?
	ORA	A
	JZ	CONT1		; If not, exit
;
	LDA	XPRDRV		; Get private drive
	JMP	CONT2		; If yes, it takes priority
;
CONT1:
	 IF	SETAREA
	LDA	XDRV		; Setarea uses a specified drive
	 ENDIF
;
	 IF	NOT SETAREA
	LDA	OLDDRV		; Otherwise get current drive
	ADI	'A'		; Convert to ASCII
;
NOTDRV:	DB	0,0		; Filled in by 'GETDU' if requested
	 ENDIF
;
CONT2:
	STA	KDRV		; Save drive for KSHOW
	SUI	40H		; Convert ASCII to binary
	STA	FCB		; Stuff in FCB
	LDA	KDRV		; Get ASCII version back again
	CALL	CTYPE		; Print the drive to store on
	LDA	PRVTFL		; Going to store in the private area?
	ORA	A
	JZ	NOPRVL		; If nope, skip ahead
;
	 IF	LOGCAL
	MVI	A,'P'		; If private upload
	STA	LOGOPT		; Show "P" as option
	 ENDIF
;
	LDA	XPRUSR		; Get private user area
	JMP	CONT3		; It takes priority
;
NOPRVL:
	 IF	SETAREA
	LDA	XUSR		; Setarea takes next precedence
	 ENDIF
;
	 IF	NOT SETAREA
	LDA	OLDUSR		; Get current drive for default
;
NOTUSR:	DB	0,0		; Filled in by 'GETDU' if requested
	 ENDIF
;
CONT3:	MVI	H,0
	MOV	L,A
	CALL	DECOUT		; Print the user area
;
	 IF	NOT DSPFNAM
	CALL	ILPRT
	DB	':',CR,LF,0
	 ENDIF
;
	 IF	DSPFNAM
	MVI	A,':'
	CALL	CTYPE		; We showed disk/user:
	LXI	H,FCB+1		; Now display filename
	CALL	DSPFN
	CALL	ILPRT
	DB	CR,LF,0
	 ENDIF
;
	CALL	KSHOW		; Show available space remaining
	CALL	ILPRT
	DB	CR,LF,0
	CALL	CHEKFIL		; See if file exists
	CALL	MAKEFIL		; If not, start a new file
	CALL	ILPRT
	DB	'File open - ready to receive',CR,LF
	DB	'To cancel: Ctrl-X, pause, Ctrl-X',CR,LF,0
;
	 IF	B3RTC AND (NOT MBMXT OR	BYEBDOS)
	CALL	GETTOS		; Get time on system
	SHLD	TOSSAV		; Save it for exit
	 ENDIF
;
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:	LHLD	RECDNO		; Check for zero length file
	MOV	A,H		; If no records, no file
	ORA	L
	JNZ	EOT1		; If not zero, continue, else abort
	CALL	RCVSABT		; Abort and erase the zero length file
	JMP	EXIT		; And exit
;
EOT1:	CALL	WRBLOCK		; Write the last block
	CALL	SENDACK		; Ack the record
	CALL	CLOSFIL		; Close the file
	XRA	A		; Clear CTYPE's console
	STA	CONONL		; Output only flag
;
	 IF	LOGLDS
	LDA	UPLDS		; Get Upload Counter
	INR	A		; One more upload since log in
	STA	UPLDS		; Update Counter
	 ENDIF
;
; Logging upload or crediting time on?
;
	 IF	LOGCAL
	LHLD	VRECNO		; If yes, get virtual # of recs
	SHLD	RCNT		; And stuff in RCNT
	CALL	FILTIM		; Calculate appox. xfer time
	 ENDIF
;
	 IF	B3RTC AND MBMXT	AND (NOT BYEBDOS)
	CALL	BYECHK		; If BYE not active
	JNZ	EXITLG		; Skip MXML update
	LHLD	0001H		; Get JMP COLDBOOT
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,MBMXO		; + MBMXO offset to MXML
	DAD	D
	MOV	A,M		; = max time allowed on system
	ORA	A		; Check it (zero?)
	JZ	EXITLG		; If unlimited time, skip update
	INR	A		; Else, increment it (for secs)
	ADD	C		; Add mins LSB (can't be >255)
	JC	MAK255		; If overflow, make it max (255)
	JZ	MAK255		; (if zero, make 255)
	MOV	M,A		; Update it (credit them for upload)
	JMP	EXITLM
;
MAK255:	MVI	A,255		; If up to max, make sure they don't
	MOV	M,A		; Get LESS than what they had..
	 ENDIF
;
	 IF	B3RTC AND NOT (BYEBDOS OR MBMXT)
	CALL	BYECHK
	JNZ	EXITLG		; SKIP this if BYE not running
	LHLD	RTCBUF		; Get address of RTCBUF in HL
	LXI	D,B3CMOS	; Add offset to mins on system
	DAD	D		; (addr in HL)
	LDA	TOSSAV		;Get saved time on system
	MOV	M,A		; And restore it
	INX	H		; (don't count upload time
	LDA	TOSSAV+1	; Against them)
	MOV	M,A
	 ENDIF
;
	 IF	BYEBDOS	AND (NOT B3RTC)
	LDA	MAXTOS		; Get maximum time allowed
	ORA	A
	JZ	EXITLG		; If zero, he's a super-guy anyway
	INR	A
	ADD	C		; Add in upload time
	JC	MAK254		; Make it 254 minutes if overflow
	JZ	MAK254		; (or zero)
	CPI	255		; (or 255)
	JNZ	MAXSTR
;
MAK254:	MVI	A,254		; (254 is max allowed)
;
MAXSTR:	STA	MAXTOS		; Save for internal use
	MOV	E,A
	MVI	C,BDSTOS	; Set maximum time on system
	CALL	BDOS
	 ENDIF
;
EXITLM:	 IF	BYEBDOS	OR (B3RTC AND MBMXT)
	CALL	ILPRT
	DB	CR,LF,'Upload time credited towards maximum timeon.'
	DB	CR,LF,0
	 ENDIF
;
	JMP	EXITLG
;
;-----------------------------------------------------------------------
;
;			SUBROUTINES
;
;-----------------------------------------------------------------------
;
;	FILTYP: Ask file type for uploads
;
	 IF	ASKAREA	AND SETAREA
;
; Routine to get file type for uploads (modified from XMDM10XX.ASM
; by Russ Pencin (Dallas Connection)). (Modify MAXTYP and TYPTBL
; near the top of the program.)
;
FILTYR:	CALL	ILPRT
	DB	CR,LF,0
;
FILTYP:	CALL	ILPRT		; Modify message as needed
	DB	CR,LF,'Is file for:',CR,LF,CR,LF
	DB	'   (1) CP/M',CR,LF
	DB	'   (2) MS/PC-DOS',CR,LF
	DB	'or (3) General interest?',CR,LF,CR,LF
	DB	'Enter choice (1, 2 or 3): ',0
	 ENDIF	;ASKAREA AND SETAREA
;
	 IF	ASKAREA	AND SETAREA AND	WRTLOC
	CALL	RSTLCK		;Turn off WRTLOC so RDCON will work
	 ENDIF
;
	 IF	ASKAREA	AND SETAREA
	MVI	C,RDCON
	CALL	BDOS
	CPI	'1'		;is it a cpm file
	JC	FILTYR		;nope, ask again use default upload area(s)
	CPI	MAXTYP+1
	JNC	FILTYR
	SUI	'1'		;GET OFFSET FOR TYPTBL
	RAL
	RAL
	MVI	D,0
	MOV	E,A
	LXI	H,TYPTBL
	DAD	D
	MOV	A,M
	STA	XDRV		;set drive
	INX	H
	MOV	A,M		;user
	STA	XUSR
	INX	H
	MOV	A,M		;private drive
	STA	XPRDRV
	INX	H
	MOV	A,M		;and private user values
	STA	XPRUSR
	CALL	ILPRT
	DB	CR,LF,0
	 ENDIF	;ASKAREA AND SETAREA
;
	 IF	ASKAREA	AND SETAREA AND	WRTLOC
	CALL	SETLCK		;Turn WRTLOC back on
	 ENDIF
;
	 IF	ASKAREA	AND SETAREA
	RET
	 ENDIF
;
;---------------------------------------------------------------------
; WRTLOC ROUTINES (SETLCK AND RSTLCK)
;
	 IF	WRTLOC AND NOT BYEBDOS
SETLCK:	CALL	BYECHK		; Is BYE running
	RNZ			; If not, skip this
	LHLD	0001H		; Get JMP COLDBOOT
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,LOCOFF	; + LOCOFF
	DAD	D
	ORI	0FFH		; = WRTLOC address
	MOV	M,A		; Turn the lock on
	RET
;
RSTLCK:	CALL	BYECHK		; Is BYE running
	RNZ			; Nope, don't touch a thing
	LHLD	0001H		; If so, time to reset it
	DCX	H		; Get JMP COLDBOOT addr.
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,LOCOFF	; + LOCOFF bytes
	DAD	D		; = WRTLOC address
	XRA	A		; Clear it
	MOV	M,A		; (so ctrl-C/ctrl-K work)
	RET
	 ENDIF	;WRTLOC AND NOT BYEBDOS
;
	 IF	WRTLOC AND BYEBDOS
SETLCK:	MVI	C,BDWRTL	; Set/Get writeloc function
	MVI	E,1		; Turn on WRTLOC flag
	CALL	BDOS
	RET
;
RSTLCK:	MVI	C,BDWRTL	; Set/Get writeloc function
	MVI	E,0		; Turn off WRTLOC flag
	CALL	BDOS
	RET
	 ENDIF
;
;---------------------------------------------------------------------
;
; Display file name function
;
	 IF	DSPFNAM		; HL=FCB address
DSPFN:	MVI	B,8
;
PRNAM:	MOV	A,M
	ANI	7FH		; Strip any attribute bits
	CPI	' '		; Don't print blanks
	CNZ	CTYPE		; Print filename
	INX	H
	DCR	B
	JNZ	PRNAM
;
PRDOT:	MVI	A,'.'		; After first part, print dot
	CALL	CTYPE
	MVI	B,3
;
PRTYP:	MOV	A,M
	ANI	7FH		; Strip any attribute bits
	CPI	' '		; Don't print blanks
	CNZ	CTYPE		; Print filetype
	INX	H
	DCR	B
	JNZ	PRTYP
	RET
	 ENDIF	; DSPFNAM
;
; Check to see if BYE is running before getting CONOUT, checking MBBS
; ACCESS byte or setting/resetting WRTLOC.  This routine also returns
; the address of the original cold boot routine in DE.
;
; Go through a big search to see if BYE is active.
;
	 IF	BYEBDOS
BYECHK:	MVI	C,32		; This bizarre combination determines
	MVI	E,241		; If BYE is not there.
	CALL	BDOS
	CPI	77		; Is it there?
	RET
	 ENDIF
;
	 IF	(NOT BYEBDOS) AND (USECON OR ACCESS OR WRTLOC)
BYECHK:	LHLD	0001H		; Point to warm boot again
	DCX	H		; If BYE active,
	MOV	D,M		; Pick up pointer to BYE variables
	DCX	H		; (COVECT) followed by 'BYE'
	MOV	E,M
	LXI	H,CONOFF	; Calculate address of BYE variable
	DAD	D		; Where ptr to orig BIOS vector stored
	MOV	E,M		; Load that address into DE, if BIOS
	INX	H		; Is active, DE now points to original
	MOV	D,M		; BIOS console output vector
	INX	H		; Point to BYE signon message
;
; Note that if more BYE variables are added after the cold boot pointer,
; extra INX may be needed.  Fix to match your BYE.
;
	MOV	A,M		; Get letter
	ANI	05FH		; Convert to upper case if needed
	CPI	'B'		; Try to match 'BYE'
	RNZ			; Out if BYE not active
	INX	H
	MOV	A,M
	ANI	05FH		; Convert to upper case if needed
	CPI	'Y'
	RNZ
	INX	H
	MOV	A,M
	ANI	05FH		; Convert to upper case if needed
	CPI	'E'
	RET
	 ENDIF
;
; 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	OPTERR
	INX	H
	MOV	A,M		; Get the char. there
	CPI	' '		; Space character?
	RET			; JZ = space, JNZ = non-space
;
; Exit, but first write record to log file and ask for description
;
EXITLG:
;
	 IF	LOGCAL OR MBDESC OR MBFMSG
	CALL	LOGCALL
	 ENDIF
;
; Ask sysop for a description of the file if ASKSYS is yes
;
	 IF	DESCRIB	AND ZCPR2 AND (NOT ASKSYS)
	LDA	WHEEL		; If its the Sysop, don't ask
	ORA	A		; For a description because he
	JNZ	EXIT		; Might want to batch recv files
	 ENDIF
;
	 IF	DESCRIB	AND NDESC
	LDA	NDSCFL		; If user picked "N" option
	ORA	A		; allow them to skip upload
	JNZ	EXIT		; descript
	 ENDIF
;
	 IF	DESCRIB	AND WRTLOC
	CALL	RSTLCK		; Clear WRTLOC before DESCRIB
	 ENDIF
;
	 IF	DESCRIB
	CALL	ASK		; If yes, ask for description of file
	 ENDIF
;
; Finished, clean up and return to CP/M, send thank-you and timeon
; messages if enabled.
;
EXIT:	XRA	A
	STA	CONONL		; Reset 'console only' flag for timeon
;
	 IF	WRTLOC
	CALL	RSTLCK		; Clear WRTLOC
	 ENDIF
;
NOBYE2:	CALL	UNINIT		; Reset vectors (if needed)
	LDA	OLDDRV		; Restore the original drive
	CALL	RECDRX
	LDA	OLDUSR		; Restore the original number
	CALL	RECARE
	LXI	D,TBUF		; Reset to default DMA address
	MVI	C,SETDMA
	CALL	BDOS
	LDA	OPTSAV		; If so check option flag
	CPI	'R'		; Was it 'R' for receive
	JNZ	EXIT1		; If not, then skip this,
	CALL	ILPRT		; And print
	DB	CR,LF,'Thanks for the upload',CR,LF,0
;
	 IF	SYSNEW
	CALL	ILPRT
	DB	CR,LF,'(Upload set as SYS file and cannot be examined'
	DB	CR,LF,'or downloaded until released by the SYSOP....)'
	DB	CR,LF,0
	 ENDIF
;
	 IF	B3RTC AND NOT (MBMXT OR	BYEBDOS)
	CALL	ILPRT		; And print
	DB	CR,LF,'Time online is not increased during uploads'
	DB	CR,LF,0
	 ENDIF
;
	 IF	MBFMSG
	LDA	MSGFLG		; Was this a "XMODEM RM" upload?
	ORA	A
	JZ	NOTMSG
	CALL	BYECHK
	JNZ	EXIT1
	CALL	ILPRT
	DB	CR,LF
	DB	'Loading MFMSG for message input, please stand by...'
	DB	CR,LF,LF,0
	LXI	D,81H		; Our buffer starts at 81H
	MVI	C,0		; C=# of characters (stuff at 80H)
	CALL	MBDFIL
	STA	80H		; Save # of chars in 80H
	MVI	A,0C2H		; Stuff C2H (JNZ instruction)
	STA	0000H
	ORA	A		; Make sure NZ flag set so JNZ will jump
	JMP	0000H
;
NOTMSG:	 ENDIF	; MBFMSG
;
	 IF	MBFMSG AND NOT MBDESC
	JMP	EXIT1		; If not message upload, exit
	 ENDIF
;
;-----------------------------------------------------------------------
;
	 IF	MBDESC AND ZCPR2 AND (NOT ASKSYS)
	LDA	WHEEL		; If its the Sysop, don't ask
	ORA	A		; For a description because he
	JNZ	EXIT1		; Might want to batch recv files
	 ENDIF
;
	 IF	MBDESC AND NDESC
	LDA	NDSCFL		; If user picked "N" option
	ORA	A		; allow them to skip upload
	JNZ	EXIT1		; descript
	 ENDIF
;
	 IF	MBDESC
	CALL	BYECHK
	JNZ	EXIT1
	CALL	ILPRT
	DB	CR,LF
	DB	'Loading MBBS for upload description, '
	DB	'please stand by...',CR,LF,LF,0
	 ENDIF
;
	 IF	MBDESC AND NEWPRV
	MVI	A,'P'		; ALL "NEW UPLOADS:" private to start
	 ENDIF
;
	 IF	MBDESC AND NOT NEWPRV
	LDA	PRVTFL		; 80H=0 if public, "P" if private
	 ENDIF
;
	 IF	MBDESC
	STA	80H		; Stuff "private" flag in page zero
	LXI	D,82H		; Our buffer starts at 82H
	MVI	C,0		; C=# of characters (stuff at 81H)
	LXI	H,MBDSH		; Heading ("NEW UPLOAD: ")
;
MBDSHP:	MOV	A,M
	CPI	0
	JZ	MBDFS
	CALL	MBDPUT
	INX	H
	JMP	MBDSHP
;
MBDFS:	CALL	MBDFIL
	STA	81H		; Save # of chars in 81H
	MVI	A,0CAH		; Stuff CAH (JZ instruction)
	STA	0000H
	XRA	A		; Make sure Z flag set so JZ will jump
	JMP	0000H
;
MBDSH:	DB	'NEW UPLOAD: ',0 ; Heading stuffed ahead of filename
	 ENDIF	; MBDESC
;
	 IF	MBDESC OR MBFMSG
MBDFIL:	LDA	FCB		; Get drive code
	ORA	A		; Check it
	JNZ	MWDRV		; If auto login, use it
	LDA	DSKSAV		; Else, get current disk
	INR	A
;
MWDRV:	ADI	'A'-1
	CALL	MBDPUT		; Stuff in command line buffer
	LDA	USRSAV		; Get user #
	CPI	10		; Are we 0-9 or above?
	JC	US0		; Must be 0-9
	ORA	A		; Clear flags
	DAA			; Decimal adjust
	RAR			; Shift down tens digit
	RAR
	RAR
	RAR
	ANI	0FH		; Mask out tens digit
	ADI	'0'		; Make it ASCII
	CALL	MBDPUT
	LDA	USRSAV
	ORA	A		; Clear flags
	DAA			; Decimal adjust
	ANI	0FH		; Mask out singles digit
;
US0:	ADI	'0'		; Make it ASCII
	CALL	MBDPUT
	MVI	A,':'		; Put in a colon
	CALL	MBDPUT
	LXI	H,FCB+1		; Stuff in filename without spaces
	MVI	B,8
;
DESNM:	MOV	A,M
	CPI	' '
	CNZ	MBDPUT
	INX	H
	DCR	B
	JNZ	DESNM
	MVI	A,'.'
	CALL	MBDPUT
	MVI	B,3
;
DESNM3:	MOV	A,M
	CPI	' '
	JZ	DESGO
	CPI	0
	JZ	DESGO
	CALL	MBDPUT
	INX	H
	DCR	B
	JNZ	DESNM3
;
DESGO:	MOV	A,C
	RET
;
MBDPUT:	ANI	7FH		; Strip off any high bits
	STAX	D		; Short routine to stuff A in (DE) and
	INX	D		; Increment pointer and character count
	INR	C
	RET
	 ENDIF	; MBDESC OR MBFMSG
;
;-----------------------------------------------------------------------
;
EXIT1:	 IF	(TIMEON	OR B3TOS) AND (NOT LUXMOD) AND TOSEXIT
	CALL	TIME		; Tell user how long he's been on
	 ENDIF
;
	 IF	(BYEBDOS AND (NOT TIMEON)) AND TOSEXIT AND (NOT	LUXMOD)
	MVI	C,BDPTOS	; Print time on system
	CALL	BDOS
	 ENDIF
;
EXIT2:	XRA	A
	LHLD	STACK
	SPHL
	RET
;
; Check local console status in order to let BYE function keys work in
; MBYE and possibly other BYE versions also.  (Your BYE must check for
; console function keys in MSTAT.)
;
	 IF	CONFUN
FUNCHK:	PUSH	B		; Save everything
	PUSH	D		; (to be safe)
	PUSH	H
	PUSH	PSW
;
CONCHK:	CALL	0000H		; Address patched in by START
;
	 ENDIF
;
	 IF	CONFUN AND SYSABT
	ORA	A		; If SYSABT set, check for
	JZ	CONDNE		; CANCEL (^X) typed by sysop
	MVI	C,RDCON
	CALL	BDOS
	CPI	CAN
	JNZ	CONDNE
	STA	SYSABF
	 ENDIF
;
CONDNE:
	 IF	CONFUN
	POP	PSW		; For BIOS JMP CONSTAT
	POP	H
	POP	D
	POP	B		; Restore everything
	RET			; And return
	 ENDIF
;
; Get Disk and User 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
	LDA	OLDDRV		; Get current drive
	STA	DUD
	ADI	'A'
	STA	RCVDRV
	MOV	A,M		; Get 1st character
	CPI	'0'
	JC	GETDU1
	CPI	'9'+1
	JC	NUMER1
;
GETDU1:	STA	RCVDRV		; Allows SYSOP to upload to any drive
	CPI	'A'-1
	JC	NUMER		; Satisfied with current drive
	SUI	'A'
	STA	DUD
;
	 IF	ZCPR2
	LDA	WHEEL		; SYSOP using the system?
	ORA	A
	LDA	DUD		; Get the value back (flags stay)
	JNZ	GETDU2		; If sysop, all things are possible
	 ENDIF
;
	 IF	NOT USEMAX
	CPI	MAXDRV
	JNC	ILLDU		; Drive selection not available
	 ENDIF
;
	 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
;
GETDU2:	INX	H		; Get 2nd character
;
NUMER:	MOV	A,M
	CPI	':'
	JZ	OK4		; Colon for drive only, no user number
	CALL	CKNUM		; Check if numeric
;
NUMER1:	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	ZCPR2
	LDA	WHEEL		; SYSOP using the system?
	ORA	A
	LDA	DUU		; Restore desired user area
	STA	RCVUSR		; Allows SYSOP to upload anywhere
	JNZ	OK3		; If yes, let him have all user areas
	 ENDIF
;
	 IF	NOT USEMAX
	CPI	MAXUSR+1	; Check for maximum user download area
	JNC	ILLDU		; Error if more (and not special area)
	 ENDIF
;
	 IF	USEMAX
	PUSH	H
	LXI	H,USRMAX	; Point at maximum user byte
	CMP	M		; And check it
	JNC	ILLDU
	POP	H
	 ENDIF
;
OK3:	MOV	E,A
;
	 IF	NOT SETAREA
	STA	NOTUSR+1	; Store requested user area
	MVI	A,3EH		; 'MVI A,--' instruction
	STA	NOTUSR
	 ENDIF
;
	MVI	C,SETUSR
	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
;
	MVI	C,SELDSK
	CALL	BDOS		; Set to requested drive
;
XIT:	JMP	TRAP		; Now find file selected
;
; Shows available space on upload disk/area.  Uses KDRV data area which
; must be loaded before calling this routine.  (So KSHOW will work with
; user specified disk if SETAREA equate is not set YES.)
;
; Print the free space remaining for the received file
;
CPMVER	EQU	0CH
CURDPB	EQU	1FH
GALLOC	EQU	1BH
SELDSK	EQU	0EH
GETFRE	EQU	46
;
KDRV:	DB	0		; Drive stored here before calling KSHOW
;
KSHOW:	LDA	KDRV		; Get drive ('A','B','C',etc.)
	SUI	41H		; Convert to numeric (0,1,2,etc.)
	MOV	E,A		; Stuff in E for BDOS call
	MVI	C,SELDSK	; Select the directory drive to retrieve
	CALL	BDOS		; The proper allocation vector
	MVI	C,CURDPB	; It's 2.X or MP/M...request DPB
	CALL	BDOS
	INX	H
	INX	H
	MOV	A,M		; Get block shift
	STA	BLKSHF
	INX	H		; Bump to block mask
	MOV	A,M
	INX	H
	INX	H
	MOV	E,M		; Get max block #
	INX	H
	MOV	D,M
	XCHG
	SHLD	BLKMAX		; Save it
	XCHG
	INX	H
	MOV	E,M		; Get directory size
	INX	H
	MOV	D,M
	XCHG
;
; Calculate # of K free on selected drive
;
	MVI	C,CPMVER	; Get CP/M version number
	CALL	BDOS
	MOV	A,L		; Get returned version number
	CPI	30H		; 3.0?
	JC	FREE20		; Use old method if not
	LDA	KDRV		; Get drive #
	SBI	'A'		; Change from ASCII to binary
	MOV	E,A		; Use new Compute Free Space BDOS call
	MVI	C,GETFRE
	CALL	BDOS
	MVI	C,3		; Answer is a 24-bit integer
;
FRE3L1:	LXI	H,80H+2		; Answer is in 1st 3 bytes of DMA adr
	MVI	B,3		; Convert it from sectors to K
	ORA	A		; By dividing by 8
;
FRE3L2:	MOV	A,M
	RAR
	MOV	M,A
	DCX	H
	DCR	B
	JNZ	FRE3L2		; Loop for 3 bytes
	DCR	C
	JNZ	FRE3L1		; Shift 3 times
	LHLD	80H		; Now get result in K
	JMP	SAVFRE		; Go store it
;
FREE20:	MVI	C,GALLOC	; Get address of allocation vector
	CALL	BDOS
	XCHG
	LHLD	BLKMAX		; Get its length
	INX	H
	LXI	B,0		; Init block count to 0
;
GSPBYT:	PUSH	D		; Save alloc address
	LDAX	D
	MVI	E,8		; Set to process 8 blocks
;
GSPLUP:	RAL			; Test bit
	JC	NOTFRE
	INX	B
;
NOTFRE:	MOV	D,A		; Save bits
	DCX	H		; Count down blocks
	MOV	A,L
	ORA	H
	JZ	ENDALC		; Quit if out of blocks
	MOV	A,D		; Restore bits
	DCR	E		; Count down 8 bits
	JNZ	GSPLUP		; Do another bit
	POP	D		; Bump to next byte..
	INX	D		; Of alloc. vector
	JMP	GSPBYT		; Process it
;
ENDALC:	POP	D		; Clear stack of allocation vector ptr.
	MOV	L,C		; Copy block to HL
	MOV	H,B
	LDA	BLKSHF		; Get block shift factor
	SUI	3		; Convert from sectors to K
	JZ	SAVFRE		; Skip shifts if 1K blocks...
;				; Return free in HL
FREKLP:	DAD	H		; Multiply blocks by K/BLK
	DCR	A
	JNZ	FREKLP
;
; Print the amount of free space remaining on the selected drive
;
SAVFRE:	CALL	DECOUT
	CALL	ILPRT
	DB	'k available for uploads',0
	RET
;
; Log into drive and user (if specified).  If none mentioned, it falls
; through to 'TRAP' routine for normal use.
;
LOGDU:	LXI	H,TBUF		; Point to default buffer command line
	MOV	B,M		; Store number of characters 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'.
;
	LXI	D,DUSAVE
	MVI	C,4		; Drive/user is 4 characters maximum
;
CPLP:	MOV	A,M
	CPI	' '+1		; Space or return, finished
	JC	TRAP
	STAX	D
	INX	H
	INX	D
	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
;
; 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 character of file name
	CPI	' '		; Any there?
	JNZ	ATRAP		; Yes, check for ambigous file name
;
NFN:	CALL	ERXIT		; Print message, exit
	DB	'++ No file name requested ++$'
;
ATRAP:	MVI	B,11		; 11 characters to check
;
TRLOOP:	MOV	A,M		; Get char from FCB
	CPI	'?'		; Ambiguous?
	JZ	TRERR		; Yes, exit with error message
	CPI	'*'		; Even more ambiguous?
	JZ	TRERR		; Yes, exit with error message
	INX	H		; Point to next character
	DCR	B		; One less to go
	JNZ	TRLOOP		; Not done, check some more
	RET
;
TRERR:	CALL	ERXIT		; Print message, exit
	DB	'++ Wild-card options are not valid ++$'
;
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 ++$'
;
; Receive a record - returns with carry bit set if EOT received
;
RCVRECD:XRA	A		; Initialize error count to zero
	STA	ERRCT
;
RCVRPT:	 IF	CONFUN		; Check for function key?
	CALL	FUNCHK		; Yeah, why not?
	 ENDIF
;
	 IF	CONFUN AND SYSABT
	LDA	SYSABF		; If SYSABT option, check
	ORA	A		; to see if Abort
	JNZ	RCVSABT		; If so, bail out now...
	 ENDIF
;
	MVI	B,10-1		; 10-second timeout
	CALL	RECV		; Get any character received
	JC	RCVSTOT		; Timeout
;
RCVRPTB:CPI	SOH		; 'SOH' for a 128-byte block?
	JZ	RCVSOH		; Yes
	CPI	STX		; A 1024-byte block?
	JZ	RCVSTX		;
	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	CAN		; CANcel?
	JZ	CANRCV		; (look for CAN CAN)
	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
;
RCVSERR:MVI	B,1		; Wait for 1 second
	CALL	RECV		; After last char. received
	JNC	RCVSERR		; Loop until sender done
	LDA	FRSTIM		; Is it the first time?
	ORA	A
	MVI	A,NAK
	JNZ	RCVSER2		; If not first time, send NAK
;
; First time through...do crc/1k/checksum select
;
	LDA	CRCFLG		; Get 'CRC' flag
	ORA	A		; 'CRC' in effect?
	MVI	A,NAK		; Put 'NAK' in accum
	JNZ	RCVSER2		; And go send it
	MVI	A,CRC		; Tell sender 'CRC' is in effect
	CALL	SEND
	LDA	KFLAG		; Did we want 1k protocol?
	ORA	A
	JZ	RCVSERX		; No, just send the "C"
	MVI	A,'K'		; Else send a C and a K
;
RCVSER2:CALL	SEND		; The 'NAK' or 'CRC' request
;
RCVSERX:LDA	ERRCT		; Abort if
	INR	A		; We have reached
	STA	ERRCT		; The error
	CPI	10		; Limit?
	JZ	RCVSABT		; Yes, abort
	CPI	5		; Have we tried 5 times already?
	JNZ	RCVRPT		; No, try again with same mode
	MVI	A,'C'		; Else flip to checksum mode if CRC
	STA	CRCFLG
	JMP	RCVRPT		; And try again
;
; Error limit exceeded, so abort
;
CANRCV:	CALL	DELAY		; Wait 100ms
	CALL	RCVRDY		; Character waiting?
	JZ	RCVRPT		; If so, no pause, skip CANcel
	MVI	B,4
	CALL	RECV		; Else wait for 2nd character
	JC	RCVSERR		; If no second character received, error
	CPI	CAN
	JNZ	RCVRPTB		; If second character not CAN, check it
;
RCVSABT:CALL	CLOSFIL		; Close file
	CALL	ILPRT
	DB	CR,LF,CR,LF,'++ Receive cancelled ++',0
	CALL	DELFILE		; Delete received file
	CALL	ERXIT		; Print second half of message
	DB	'++ Partial file deleted ++$'
;
; Deletes the received file (used if receive aborts)
;
DELFILE:LXI	D,FCB		; Point to file
	MVI	C,DELET		; 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	RCVSERR		; Bump error count, etc.
;
; Got SOH or STX - get block number, block number complemented
;
RCVSOH:	LXI	H,128		; 128 bytes in this block
	XRA	A		; Zero-out KFLAG
	JMP	RCVHDR
;		;
RCVSTX:	MVI	A,0FFH		; Set KFLAG true
	LXI	H,1024		; 1024 bytes in block
;
RCVHDR:	SHLD	BLKSIZ		; Store block size for later
	STA	KFLAG		; Set KFLAG as appropriate
	MVI	B,1		; Timeout = 1 sec
	MVI	A,1		; Need something to store at FRSTIM
	STA	FRSTIM		; Indicate first 'SOH' received
	CALL	RECV		; Get record
	JC	RCVSTOT		; Got timeout
	MOV	D,A		; D=block number
	MVI	B,1		; Timeout = 1 sec
	CALL	RECV		; Get complimented record number
	JC	RCVSTOT		; Timeout
	CMA			; Calculate the  complement
	CMP	D		; Good record number?
	JZ	RCVDATA		; Yes, get data
;
; Got bad record number
;
	JMP	RCVSERR		; Bump error count
;
RCVDATA:MOV	A,D		; Get record number
	STA	RCVRNO		; Save it
	MVI	C,0		; Initialize checksum
	CALL	CLRCRC		; Clear CRC counter
	LHLD	BLKSIZ		; Get block size,
	XCHG			; And put in DE pair to initialize count
	LHLD	RECPTR		; Get buffer address
;
RCVCHR:	MVI	B,1		; 1 sec timeout
	CALL	RECV		; Get the character
	JC	RCVSTOT		; Timeout
	MOV	M,A		; Store the character
	INX	H		; Point to next character
	DCX	D		; Done?
	MOV	A,D
	ORA	E
	JNZ	RCVCHR		; No, loop if <= BLKSIZ
	LDA	CRCFLG		; Get 'CRC' flag
	ORA	A		; 'CRC' in effect?
	JZ	RCVCRC		; Yes, to receive 'CRC'
;
; Verify checksum
;
	MOV	D,C		; Save checksum
	MVI	B,1		; Timeout length
	CALL	RECV		; Get checksum
	JC	RCVSTOT		; Timeout
	CMP	D		; Checksum ok?
	JNZ	RCVSERR		; 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
;
; 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 requesting the record be sent again.
;
RCVCRC:	MVI	E,2		; Number of bytes to receive
;
RCVCRC2:MVI	B,1		; 1 sececond timeout
	CALL	RECV		; Get crc byte
	JC	RCVSTOT		; Timeout
	DCR	E		; Decrement the number of bytes
	JNZ	RCVCRC2		; Get both bytes
	CALL	CHKCRC		; Check received CRC against calc'd CRC
	ORA	A		; Is CRC okay?
	JZ	CHKSNUM		; Yes, go check record numbers
	JMP	RCVSERR		; 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
;
; Send the record header
;
; Send	[(SOH) or (STX)] (block number) (complemented block number)
;
SENDHDR:LDA	KFLAG		; 1k blocks enabled?
	ORA	A
	JNZ	SENDBIG		; Yes
	MVI	A,SOH		; 128 blocks, use SOH
	JMP	MORHDR		; Send it
;
SENDBIG:MVI	A,STX		; 1024 byte block -  Start of Header
;
MORHDR:	CALL	SEND		; One Start of Header or another
	LDA	RECDNO		; Then send record number
	CALL	SEND
	LDA	RECDNO		; Then record number
	CMA			; Complemented
	CALL	SEND		; Record number
	RET			; From SENDHDR
;
; Send the data record
;
SENDREC:MVI	C,0		; Initialize checksum
	CALL	CLRCRC		; Clear the 'CRC' counter
	LDA	KFLAG		; Are we using 1K blocks?
	ORA	A
	JNZ	SEND1		; Yes, 1k size
	LXI	D,128		; Initialize small count
	JMP	SEND2
;
SEND1:	LXI	D,1024		; Initialize big count
;
SEND2:	LHLD	RECPTR		; Get buffer address
;
SENDC:	MOV	A,M		; Get a character
	CALL	SEND		; Send it
	INX	H		; Point to next character
	DCX	D		; Done?
	MOV	A,D
	ORA	E
	JNZ	SENDC		; Loop if <=Blocksize
	RET			; From SENDREC
;
; Send the checksum
;
SENDCKS:MOV	A,C		; Send the
	CALL	SEND		; Checksum
	RET			; From 'SENDCKS'
;
; Send the two Cyclic Redundancy Check characters.  Call FINCRC to cal-
; culate 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
;
; 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,10		; Wait 10 seconds max
	CALL	RECVDG		; Receive with garbage collect
	JC	ACKERR		; Timed out
	CPI	ACK		; Was it an 'ACK' character?
	RZ			; Yes, return
;
	 IF	RETRY
	CPI	NAK		; Was it an authentic 'NAK'?
	JNZ	GETACK		; Ignore if neither 'ACK' nor 'NAK'
	 ENDIF
;
; Timeout or error on ACK - bump error counters then resend the record
; if error limit is not exceeded.
;
ACKERR:	LDA	ERRCT		; Get count
	INR	A		; Bump it
	STA	ERRCT		; Save back
	LHLD	TOTERR		; Total errors this run
	INX	H
	SHLD	TOTERR		; Update and put back
	CPI	10		; At limit?
	RC			; If not, go resend the record
;
; Reached error limit
;
	CALL	ERXIT
	DB	'++ Send file cancelled ++$'
;
CHKERR:	LDA	KFLAG
	ORA	A		; Check to see if in 1024 mode
	RZ			; No, so don't bother with rest
	LHLD	TOTERR		; Check on errors to date...
	MOV	A,L		; Skip if less than DWNSHFT error so far
	CPI	DWNSHFT
	RC			; Not enough errors to bother with yet
	XCHG			; Total errors to DE
	LHLD	RECDNO		; Get records sent so far
	CALL	DVHLDE		; Divide by errors so far
	MOV	A,C		; Take low order byte of quotient...
	CPI	DWNSHFT		; Compare to specified ratio...
	RNC			; Better ratio than needed, so return
	XRA	A		; Noisy line, let's try
	STA	KFLAG		; 128 byte blocks
	RET
;
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 aborted ++$'
;
; Increment record number
;
INCRRNO:PUSH	H
	LHLD	RECDNO		; Increment record number
	INX	H
	SHLD	RECDNO
	LHLD	VRECNO		; Update Virtual Record Number
	LDA	KFLAG		; Was last record a 1024 byte one?
	ORA	A		;
	JZ	INCRR1		; Just handled an normal 128 byte record
	INX	H		; Otherwise, must have be a BIG one, so
	INX	H		; Seven ...
	INX	H
	INX	H
	INX	H
	INX	H
	INX	H		; Plus
;
INCRR1:	INX	H		; One
	SHLD	VRECNO		; Equals the new virtual record number
;
	 IF	NOT (USECON OR BYEBDOS)
	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
	 ENDIF
;
; Display the record count on the local CRT if "CONOUT" was filled in by
; the implementor
;
	MVI	A,1
	STA	CONONL		; Set local only
	LDA	OPTSAV		; See if receive or send mode
	CPI	'R'
	JZ	RMSG
	CALL	ILPRT
	DB	CR,'Sending # ',0
	JMP	REST
;
RMSG:	CALL	ILPRT
	DB	CR,'Received # ',0
;
REST:	LDA	KFLAG
	ORA	A
	JZ	REST1
	LHLD	VRECNO
	DCX	H		; Stupid but simple way to subtract 7
	DCX	H		; Without dying on high-byte
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	CALL	DECOUT
	MVI	A,'-'
	CALL	CTYPE
;
REST1:	LHLD	VRECNO		; Virtual record number to minimize
	CALL	DECOUT		; Confusion between 1K and normal
	CALL	ILPRT		; 'record' sizes (always in terms of
	DB	' ',18H,0	; 128-byte records)
;
	 IF	CONFUN		; Check for sysop console function
	CALL	FUNCHK		; Keys if CONFUN EQU YES
	 ENDIF
;
INCRN5:	POP	H		; Here from above if no CONOUT
	RET
;
; See if file exists - if it exists, ask for a different name.
;
CHEKFIL: IF	NOT SETAREA
	LDA	PRVTFL		; Receiving in private area?
	ORA	A
	CNZ	RECAREA		; If yes, set drive and user area
	 ENDIF
;
	 IF	SETAREA
	CALL	RECAREA		; Set the designated area up
	 ENDIF
;
	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 ++$'
;
; 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		; 0FFH=bad?
	RNZ			; Open ok
;
; Directory full - can't make file
;
	CALL	ERXIT
	DB	'++ Error: can''t make file -'
	DB	' directory may be full? ++$'
;
; Computes record count, and saves it until a successful file-open.
;
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	'++ File not found, check DIR ++','$'
;
; 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	OPENOK		; If yes, exit
	LDA	OPTSAV		; Get command line option
	CPI	'L'		; Want to send a library file?
	JNZ	NONAME		; Exit, if not
	CALL	ILPRT
	DB	CR,LF,'++ Member not found, check DIR ++',CR,LF,0
	JMP	OPTERR
;
; Check to see if the SYSOP has tagged a .LBR file for NO SEND - if so,
; only allow XMODEM L NAME to transfer individual files. If requested
; file is a $SYS file or has any high bits set, disallow unless WHEEL.
;
OPENOK:	 IF	ZCPR2
	LDA	WHEEL		; Check wheel status if ZCPR2
	ORA	A		; Is it zero
	JNZ	OPENOK1		; If non-zero skip all restrictions
	 ENDIF
;
	 IF	DWNTAG
	LDA	FCB+3		; Regardless of access byte?
	ANI	80H		; If so,
	JNZ	OPENOK1		; Allow it if F3 set regardless
	 ENDIF
;
	 IF	ACCESS
	CALL	BYECHK
	JNZ	SNDFOK
	LHLD	0001H		; Get JMP COLDBOOT
	DCX	H
	MOV	D,M
	DCX	H
	MOV	E,M
	LXI	H,ACBOFF	; + ACBOFF
	DAD	D
	MOV	A,M		; = ACCESS byte address
	ANI	ACDNLD		; Test download access bit
	JNZ	SNDFOK		; If bit on, downloads OK
	CALL	ERXIT
	DB	'Sorry, but you are not allowed to download files '
	DB	'at this time...','$'
	 ENDIF
;
SNDFOK:	 IF	NOSYS AND NOT LUXMOD
	LDA	FCB+10
	ANI	80H
	JNZ	NONAME		; If $SYS then fake a "file not found"
	 ENDIF
;
	 IF	OK2400 AND TAGLBR AND NOT LUXMOD
	LDA	MSPEED		; Check baudrate byte set by BYE
	CPI	6		; Is caller >=2400 baud?
	JNC	OPENOK1		; If so - let em send the file (PAT2)
	 ENDIF
;
	 IF	TAGLBR AND NOT LUXMOD
	LDA	OPTSAV		; Has SYSOP tagged a large .LBR file?
	CPI	'L'		; Using XMODEM L?
	JZ	OPENOK1		; Yes, skip tag test
	LDA	FCB+1		; First char of file name
	ANI	80H		; Check bit 7 for tag
	JZ	OPENOK1		; If on, file cannot be sent
	 ENDIF
;
	 IF	TAGLBR AND NOT LUXMOD
OPENOT:	CALL	ERXIT		; Exit with message
	DB	'++ File is not for distribution, sorry. ++',CR,LF,CR,LF
	DB	'For large LBR files please use XMODEM L or LUX',CR,LF
	DB	'to transfer individual member files','$'
	 ENDIF
;
OPENOK1:LDA	OPTSAV
	CPI	'L'
	JNZ	OPN2
	LXI	D,TBUF
	MVI	C,SETDMA
	CALL	BDOS
	MVI	C,READ
	LXI	D,FCB
	CALL	BDOS
	ORA	A		; Read ok?
	JNZ	LERROR
	LHLD	TBUF+14		; Value in buffer where DIRSIZE is
	SHLD	DIRSZ
	LXI	H,TBUF
	MOV	A,M
	ORA	A
	JZ	CKDIR		; Check directory present?
;
NOTLBR:	CALL	ERXIT
	DB	'++ Bad .LBR directory, notify Sysop ++','$'
;
; 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 records!
	LXI	H,TBUF		; 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 characters
	MOV	E,M		; Got the file - get file address
	INX	H
	MOV	D,M
	XCHG
	SHLD	INDEX		; Save file address in .LBR
	XCHG
	INX	H
	MOV	E,M		; Get the file size
	INX	H
	MOV	D,M
	XCHG
	DCX	H
	SHLD	RCNT		; Save size a # 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	OPENOK3		; 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	'++ Member not found, check DIR ++$'
;
INLBR:	DCX	H		; Decrement dirctory size
	SHLD	DIRSZ
	MVI	C,READ		; Read next sector of directory
	LXI	D,FCB
	CALL	BDOS
	ORA	A		; Read ok?
	JNZ	LERROR
	LXI	H,TBUF		; Set our pointers for compare
	LXI	D,MEMFCB
	JMP	CMLP		; Check next sector
;
OPN2:	 IF	ZCPR2
	LDA	WHEEL		; Check status of wheel if zcpr2
	ORA	A		; Is it zero
	JNZ	OPENOK3		; If not then skip the # and .com check
	 ENDIF
;
	 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
;
	 IF	NOLBS		; Do not allow '#' to be sent
	CPI	'#'		; Chk for '#' as last first
	JNZ	OPELOK		; If '#', can not send, show why
	CALL	ERXIT
	DB	'++ File not for distribution ++$'
;
OPELOK:	 ENDIF
;
	 IF	NOCOMS		; Do not allow '.COM' to be sent
	CPI	'M'		; If not, check for '.COM'
	JNZ	OPENOK3		; If not, ok to send
	DCX	H
	MOV	A,M		; Check next character
	ANI	7FH		; Strip attributes
	CPI	'O'		; 'O'?
	JNZ	OPENOK3		; 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	OPENOK3		; If not, continue
	CALL	ERXIT		; Exit with message
	DB	'++ Sending .COM files not allowed ++$'
	 ENDIF	; NOCOMS
;
OPENOK3: IF	NOT DSPFNAM
	CALL	ILPRT		; Print the message
	DB	'File open: ',0
	 ENDIF
;
	 IF	DSPFNAM
	CALL	ILPRT
	DB	'Sending: ',0
	LDA	OPTSAV
	CPI	'L'
	JNZ	SFNNL		; If not L opt, just show name
	LXI	H,MEMFCB
	CALL	DSPFN
	CALL	ILPRT
	DB	' from ',0
;
SFNNL:	LXI	H,FCB+1
	CALL	DSPFN
	CALL	ILPRT
	DB	CR,LF,'File size: ',0
	 ENDIF
;
	LHLD	RCNT		; Get record count
	LDA	OPTSAV
	CPI	'L'
	JNZ	OPENOK4		; If send from library add 1 to
	INX	H		; Show correct record count
;
OPENOK4:CALL	CKKSIZ		; Check to see if it is at least 1K...
	CALL	DECOUT		; Print decimal number of records
	PUSH	H
	CALL	ILPRT
	DB	' records (',0
	POP	H		; Get # of 128 byte records
	LXI	D,8		; Divide by 8
	CALL	DVHLDE		; To get # of 1024 byte blocks
	MOV	A,H
	ORA	L		; Check if remainder
	MOV	H,B		; Get quotient
	MOV	L,C
	JZ	EXKB		; If 0 remainder, exact kilobytes
	INX	H		; Else, increment to next k
;
EXKB:	CALL	DECOUT		; Show # of kilobytes
	CALL	ILPRT
	DB	'k)',CR,LF,0
	CALL	ILPRT
	DB	'Send time: ',0
	CALL	FILTIM		; Get file xfer time in mins in BC
	PUSH	H		; Save seconds in HL
;
	 IF	ZCPR2 AND MAXTIM
	LDA	WHEEL		; Check wheel status if zcpr2
	ORA	A		; Is it zero
	JNZ	SKIPTIM		; If its not then skip the limit
	 ENDIF
;
	 IF	OK2400		; No restrictions for 2400 bps callers?
	LDA	MSPEED		; Check baudrate byte set by BYE
	CPI	6		; Is >=2400?
	JNC	SKIPTIM		; If so, skip time check
	 ENDIF
;
	 IF	MAXTIM
	MOV	A,C		; If limiting get length of this program
	INR	A		; Increment to next full minute
	 ENDIF
;
	 IF	MAXTIM AND TIMEON
	LXI	H,TON
	ADD	M		; Add time on to xfer time, TON will
	 ENDIF
;
	 IF	MAXTIM
	STA	MINUTE		; Store value for later comparison
	MOV	A,B		; Get high byte of minute if >255
	JNZ	MXTMC2		; If no carry from increment/add
	INR	A
;
MXTMC2:	STA	MINUTE+1
	 ENDIF
;
SKIPTIM:MOV	L,C
	MOV	H,B
	CALL	DECOUT		; Print decimal number of minutes
	MVI	A,':'
	CALL	CTYPE		; Output colon
	POP	H		; Get seconds
	MOV	A,L
	CPI	10
	MVI	A,'0'		; Needs a leading zero
	CC	CTYPE
	CALL	DECOUT		; Print the seconds portion
	CALL	ILPRT
	DB	' 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,PRINT		; Show the baud
	CALL	BDOS
	CALL	SPEED
	CPI	5
	MVI	A,'0'		; Adds a zero for 1200, 2400, 4800 and
	CNC	CTYPE		; 9600 bps
;
OPENOK5:CALL	ILPRT
	DB	' baud',CR,LF,0
;
	 IF	ZCPR2 AND MAXTIM
	LDA	WHEEL		; Check wheel status if zcpr2
	ORA	A		; Is it zero
	JNZ	SKIPEM		; If not then no time limits
	 ENDIF
;
	 IF	MAXTIM AND (BYEBDOS OR MXTOS)
	LDA	MAXTOS		; Get maximum time on system
	ORA	A		; If zero, this guy is a winner
	JZ	SKIPEM		; (skip restrictions)
	LDA	MINUTE+1	; Is it over 255 minutes?
	ORA	A
	JNZ	OVERTM
	 ENDIF
;
	 IF	MTL
	CALL	GETTOS		; Get time on system in HL
	 ENDIF
;
	 IF	MAXTIM AND BYEBDOS AND (NOT TIMEON)
	MVI	C,BDGRTC	; Get time on system in A
	CALL	BDOS
	MOV	B,A		; Put in B
	 ENDIF
;
	 IF	MAXTIM AND (BYEBDOS OR MXTOS)
	LDA	MAXTOS
	INR	A
	 ENDIF
;
	 IF	MAXTIM AND BYEBDOS AND (NOT TIMEON)
	SUB	B
	 ENDIF
;
	 IF	MTL
	SUB	L		; Get how much time is left
	ADI	MAXMIN		; Give them MAXMIN extra
	 ENDIF
;
	 IF	MAXTIM AND (BYEBDOS OR MXTOS)
	MOV	B,A		; Put max time on sys in B
	LDA	MINUTE		; Are we > max time on sys?
	CMP	B
	JNC	OVERTM
	 ENDIF
;
	 IF	MAXTIM AND NOT (BYEBDOS	OR MXTOS)
	LDA	MINUTE+1	; Get minute count high byte
	ORA	A		; Check if zero
	JNZ	OVERTM		; If not, is over 255 minutes!
	LDA	MINUTE		; Get minute count
	CPI	MAXMIN+1	; Compare to MAXTIM value
	JNC	OVERTM		; If greater than MAXTIM
	 ENDIF
;
SKIPEM:	CALL	ILPRT
	DB	'To cancel: Ctrl-X, pause, Ctrl-X',CR,LF,0
	RET
;
	 IF	MAXTIM
OVERTM:	CALL	ILPRT
	DB	CR,LF,'++ XMODEM ABORTED - send time exceeds the ',0
	 ENDIF
;
	 IF	MAXTIM AND NOT (BYEBDOS	OR MXTOS)
	LXI	H,MAXMIN
	 ENDIF
;
	 IF	MAXTIM AND BYEBDOS
	MVI	C,BDGRTC
	CALL	BDOS
	MOV	B,A
	 ENDIF
;
	 IF	MTL
	CALL	GETTOS		; Get TOS back into HL
	 ENDIF
;
	 IF	MAXTIM AND (BYEBDOS OR MXTOS)
	LDA	MAXTOS
	 ENDIF
;
	 IF	MAXTIM AND BYEBDOS
	SUB	B
	 ENDIF
;
	 IF	MTL
	SUB	L		; Get time left
	ADI	MAXMIN		; Add MAXMIN
	 ENDIF
;
	 IF	MAXTIM AND (BYEBDOS OR MXTOS)
	MVI	H,0
	MOV	L,A
	 ENDIF
;
	 IF	MAXTIM
	CALL	DECOUT
	CALL	ERXIT1
	DB	' minutes allowed ++$'
	 ENDIF
;
BTABLE:	 IF	NOT STOPBIT	; One stop bit
	DW	5,13,19,25,30,48,85,141,210,280,0
	 ENDIF
;
	 IF	STOPBIT		; Two stop bits
	DW	5,12,18,23,27,44,78,128,191,255,0
	 ENDIF
;
KTABLE:	 IF	NOT STOPBIT	; One stop bit
	DW	5,14,21,27,32,53,101,190,330,525,0
	 ENDIF
;
	 IF	STOPBIT		; Two stop bits
	DW	5,13,19,25,29,48,92,173,300,477,0
	 ENDIF
;
RECTBL:	 IF	NOT STOPBIT	; One stop bit
	DB	192,74,51,38,32,20,11,8,5,3,0
	 ENDIF
;
	 IF	STOPBIT		; Two stop bits
	DB	192,80,53,42,36,22,12,7,5,4,0
	 ENDIF
;
KECTBL:	 IF	NOT STOPBIT	; One stop bit
	DB	192,69,46,36,30,18,10,5,3,2,0
	 ENDIF
;
	 IF	STOPBIT		; Two stop bits
	DB	192,74,51,38,33,20,10,6,3,2,0
	 ENDIF
;
SPTBL:	DB	'110$','300$','450$','600$','710$','120$','240$'
	DB	'480$','960$','1920$'
;
; Pass record count in RCNT: returns file's approximate download/upload
; time in minutes in BC, seconds in HL, also stuffs the # of mins/secs
; values in PGSIZE if LOGCAL is YES.
;
FILTIM:	CALL	SPEED		; Get speed indicator
	MVI	D,0
	MOV	E,A		; Set up for table access
	LXI	H,BTABLE	; Point to baud factor table
	LDA	KFLAG
	CPI	'K'
	JNZ	FILTI1
	LXI	H,KTABLE	; The guy is using 1k file xfers
;
FILTI1:	DAD	D		; Index to proper factor
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	LHLD	RCNT		; Get number of records
	LDA	OPTSAV
	CPI	'L'		; If not L download
	JNZ	SKINCR		; Skip increment of record count
	INX	H		; Increment record count
;
SKINCR:	CALL	DVHLDE		; Divide HL by value in DE (records/min)
	PUSH	H		; Save remainder
	LXI	H,RECTBL	; Point to divisors for seconds calc.
	LDA	KFLAG
	CPI	'K'
	JNZ	FILTI2
	LXI	H,KECTBL	; The guy is using 1k file transfers
;
FILTI2:	MVI	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	MULHLA		; Multiply 'H' by 'A'
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	MVI	H,0		; HL now = seconds (L=secs,H=0)
;
	 IF	LOGCAL
	MOV	A,C		; Add minutes of length (to 0 or 1)
	STA	PGSIZE		; Save as LSB of minutes
	MOV	A,B		; Get MSB of minutes
	STA	PGSIZE+1	; Save as MSB of minutes (>255?)
	MOV	A,L		; Get LSB of seconds (can't be >59)
	STA	PGSIZE+2	; Save for LOGCALL
	 ENDIF
;
	RET			; End of FILTIM routine
;
; Divides 'HL' by value in 'DE' - upon exit: BC=quotient, HL=remainder
;
DVHLDE:	PUSH	D		; Save divisor
	MOV	A,E
	CMA			; Negate divisor
	MOV	E,A
	MOV	A,D
	CMA
	MOV	D,A
	INX	D		; 'DE' is now two's complemented
	LXI	B,0		; Init quotient
;
DIVL1:	DAD	D		; Subtract divisor from divident
	INX	B		; Bump quotient
	JC	DIVL1		; Loop until sign changes
	DCX	B		; Adjust quotient
	POP	D		; Retrieve divisor
	DAD	D		; Readjust remainder
	RET
;
; Multiply the value in 'HL' by the value in 'A', return with answer in
; 'HL'.
;
MULHLA:	XCHG			; Multiplicand to 'DE'
	LXI	H,0		; Init product
	INR	A
;
MULLP:	DCR	A
	RZ
	DAD	D
	JMP	MULLP
;
; Shift the 'HL' register 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,128
	ORA	L
	MOV	L,A
	RET
;
; Closes the received file
;
CLOSFIL:LXI	D,FCB		; Point to file
	MVI	C,CLOSE		; Get function
	CALL	BDOS		; Close it
	INR	A		; Close ok?
	JNZ	CLSEXIT		; Yes, continue
	CALL	ERXIT		; No, abort
	DB	'++ Can''t close file ++$'
;
CLSEXIT:
	 IF	SYSNEW
	LDA	FCB+10		; Set $SYS attribute
	ORI	80H
	STA	FCB+10
	LXI	D,FCB		; Point to file
	MVI	C,SETATT	; Set attribute function
	CALL	BDOS
	 ENDIF
;
	RET
;
; Decimal output routine - call with decimal value in 'HL'
;
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
;
; Makes sure there are enough records to send.	For speed, this routine
; buffers up 16 records at a time.
;
RDRECD:	LDA	KFLAG		; Check for 1024 byte records
	ORA	A
	JNZ	RDRECDK		; Using 1K blocks
;
NOTKAY:	LDA	RECNBF		; Get number of records in buffer
	DCR	A		; Decrement it
	JM	RDBLOCK		; Exhausted?  need more
	ORA	A		; Otherwise, clear carry and...
	RET			; From 'RDRECD'
;
RDRECDK:LDA	RECNBF		; Get number of records in buffer
	ORA	A		; Any records in buffer?
	JZ	RDBLOCK		; Nope, get more
	SUI	8		; Decrement count of records
	RNC			; 8 or more left
	XRA	A		; Less than 8 left
	STA	KFLAG		; Revert to 128 blocks
	JMP	NOTKAY		; Continue with short blocks
;
; Update buffer pointers and counters AFTER sending a good block.
;
UPDPTR:	LDA	KFLAG
	ORA	A
	JNZ	BIG
	LXI	D,128		; Small pointer increment
	MVI	B,1		; Small sector number
	JMP	UPDPTR1
;
BIG:	LXI	D,1024		; Big pointer increment
	MVI	B,8		; Number of sectors in big block
;
UPDPTR1:LDA	RECNBF		; Update buffer sector count
	SUB	B
	STA	RECNBF
	LHLD	RECPTR		; Get buffer address
	DAD	D		; To next buffer
	SHLD	RECPTR		; Save buffer address
	RET
;
; 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
;
LERROR:	CALL	ERXIT
	DB	'++ File read error ++$'
;
RDRECOK:LXI	H,128		; Add length of one record
	DAD	D		; To next buffer
	XCHG			; Buffer to 'DE'
	INR	C		; More records?
	MOV	A,C		; Get count
	CPI	BUFSIZ*8	; 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		; Init buffer pointear
	SHLD	RECPTR		; Save buffer address
	LXI	D,TBUF		; Reset DMA address
	MVI	C,SETDMA
	CALL	BDOS
	JMP	RDRECD		; Pass record to caller
;
; 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	BLKSIZ		; Get length of last record
	XCHG			; Get ready for add
	LHLD	RECPTR		; Get buffer address
	DAD	D		; To next buffer
	SHLD	RECPTR		; Save buffer address
	XCHG			; Move BLKSIZ to HL
	CALL	SHFTHL		; Divide by 128 to get recors
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	CALL	SHFTHL
	LDA	RECNBF		; Bump the records number in the buffer
	ADD	L
	STA	RECNBF
	CPI	BUFSIZ*8	; Equal to, or past 'end' of buffer?
	RC			; No, return
;
; 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,TBUF		; 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 ++$'
;
; 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:	CALL	GETCHR
	CALL	GETCHR
;
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:	 IF	NOT BYEBDOS
	LXI	D,6600		; 1 second DCR count
	 ENDIF
;
	 IF	BYEBDOS
	LXI	D,2800		; (includes BYEBDOS overhead)
	 ENDIF
;
MWTI:	CALL	RCVRDY		; Input from modem ready
	JZ	MCHAR		; Got the character
	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 it does
; not 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 'DE'
	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 the character
	ORA	A		; Carry off: no error
	RET			; From 'RECV'
;
; Common carrier test for receive 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.
;
	 IF	NOT (USECON OR BYEBDOS)
	LHLD	CONOUT+1	; Get conout address
	MOV	A,H		; Zero if no local console
	ORA	L
	JZ	CARCK2
	 ENDIF
;
	MVI	A,1		; Print local only
	STA	CONONL
	CALL	ILPRT		; 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 MSP byte
	ORA	C		; Count = zero?
	JNZ	DELAY2		; If not, continue
	POP	B		; Restore 'BC'
	RET			; Return to CARCK1
;
;-----------------------------------------------------------------------
;
; Tells user to add description of an uploaded file
;
	 IF	DESCRIB
ASK:	LDA	OPTSAV		; Get the option
	CPI	'R'
	RNZ			; If not receiving a file, exit
	LDA	PRVTFL		; Sending to "private area"?
	ORA	A
	RNZ			; If yes, do not ask for description
	 ENDIF
;
	 IF	DESCRIB	AND ZCPR2 AND (NOT ASKSYS)
	LDA	WHEEL
	ORA	A
	RNZ
	 ENDIF
;
	 IF	DESCRIB
	MVI	B,2		; Short delay to wait for an input char.
	CALL	RECV
	 ENDIF
;
	 IF	DESCRIB	AND ASKIND
ASK1:	CALL	DELAY
	CALL	SHONM		; Show the file name
	CALL	DILPRT
	DB	' - this file is for:',CR,LF,CR,LF,0
	MVI	C,PRINT		; Display the file descriptors
	LXI	D,KIND0
	CALL	BDOS
	CALL	DILPRT
	DB	CR,LF,'Select one: ',0
	CALL	INPUT		; Get a character
	CALL	TYPE
	CPI	'0'
	JC	ASK1
	CPI	'9'+1
	JNC	ASK1
	STA	KIND
	 ENDIF
;
	 IF DESCRIB AND	(NOT ASKIND)
ASK1:	CALL	DELAY
	CALL	SHONM
	 ENDIF
;
	 IF	DESCRIB
ASK2:	LXI	H,0
	SHLD	OUTPTR		; Initialize the output pointers
	CALL	DILPRT
	DB	CR,LF,CR,LF
	DB	'Please describe this file (7 lines or less).  Tell '
	DB	'what equipment can use',CR,LF,'it and what the '
	DB	'program does.  Extra RET to quit.',CR,LF,CR,LF,0
	CALL	SENBEL
;
; Get the file name from FCB, skip any blanks
;
	LXI	H,HLINE
	CALL	DSTOR1
	MVI	B,8		; Get FILENAME
	LXI	D,FCB+1
	LXI	H,OLINE
	CALL	LOPFCB
	MVI	M,'.'
	MOV	A,M		; Separate FILENAME and EXTENT
	CALL	TYPE
	INX	H
	MVI	B,3		; Get EXTENT name
	CALL	LOPFCB
	 ENDIF
;
	IF	DESCRIB	AND ASKIND
AFIND1:	LDA	KIND
	CPI	'0'		; File category 0
	LXI	D,KIND0+4
	CZ	DKIND		; File category 1
	CPI	'1'
	LXI	D,KIND1+4
	CZ	DKIND		; File category 1
	CPI	'2'
	LXI	D,KIND2+4
	CZ	DKIND		; File category 2
	CPI	'3'
	LXI	D,KIND3+4
	CZ	DKIND		; File category 3
	CPI	'4'
	LXI	D,KIND4+4
	CZ	DKIND		; File category 4
	CPI	'5'
	LXI	D,KIND5+4
	CZ	DKIND		; File category 5
	CPI	'6'
	LXI	D,KIND6+4
	CZ	DKIND		; File category 6
	CPI	'7'
	LXI	D,KIND7+4
	CZ	DKIND		; File category 7
	CPI	'8'
	LXI	D,KIND8+4
	CZ	DKIND		; File category 8
	CPI	'9'
	LXI	D,KIND9+4
	CZ	DKIND		; File category 9
	 ENDIF			; DESCRIB AND ASKIND
;
	 IF DESCRIB AND	(NOT ASKIND)
	MVI	M,CR
	INX	H
	MVI	M,LF
	 ENDIF
;
	 IF	DESCRIB
	CALL	DSTOR		; Put FILENAME line into memory
	CALL	DILPRT
	DB	CR,LF,CR,LF,'0: ---------1---------2---------3'
	DB	'---------4---------5---------6---------',CR,LF,0
	XRA	A
	STA	ANYET		; Reset the flag for no information yet
	MVI	C,'0'
;
EXPLN:	INR	C
	MOV	A,C
	CPI	'7'+1
	JNC	EXPL1
	CALL	TYPE
	MVI	A,' '
	CALL	OUTCHR
	CALL	OUTCHR
	CALL	OUTCHR
	CALL	DILPRT
	DB	': ',0
	CALL	DESC		; Get a line of information
	CALL	DSTOR
	JMP	EXPLN
;
EXPL1:
	MVI	A,CR		; All finished, put in an extra CR-LF
	CALL	OUTCHR
	MVI	A,LF
	CALL	OUTCHR
	MVI	A,'$'
	CALL	OUTCHR
	CALL	DILPRT
	DB	'   Repeating to verify:',CR,LF,CR,LF,0
	LHLD	OUTADR
	XCHG
	MVI	C,PRINT
	CALL	BDOS
	LHLD	OUTPTR
	DCX	H
	SHLD	OUTPTR
;
EXPL2:	CALL	DILPRT
	DB	CR,LF,'Is this ok (Y/N)? ',0
	CALL	INPUT
	CALL	TYPE		; Display answer
	ANI	5FH		; Change to upper case
	CPI	'N'
	JZ	ASK1		; If not, do it over
	CPI	'Y'
	JNZ	EXPL2		; If yes, finish up, else ask again
;
; Now open the file and put this at the beginning
;
EXPL3:	LDA	0004H		; Get current drive/user
	STA	DRUSER		; Store
;
; Set drive/user to the area listed above
;
	MVI	E,USER		; Set user to WHATSFOR.TXT area
	MVI	C,SETUSR
	CALL	BDOS
	MVI	A,DRIVE		; Set drive to WHATSFOR.TXT area
	SUI	41H
	MOV	E,A
	MVI	C,SELDSK
	CALL	BDOS
;
; Open source file
;
	CALL	DILPRT
	DB	CR,LF,0
	LXI	D,FILE		; Open WHATSFOR.TXT file
	MVI	C,OPEN
	CALL	BDOS
	INR	A		; Check for no open
	JNZ	OFILE		; File exists, exit
	MVI	C,MAKE		; None exists, make a new file
	LXI	D,FILE
	CALL	BDOS
	INR	A
	JZ	NOROOM		; Exit if cannot open new file
;
OFILE:	LXI	H,FILE		; Otherwise use same filename
	LXI	D,DEST		; With .$$$ extent for now
	MVI	B,9
	CALL	MOVE
;
; Open the destination file
;
	XRA	A
	STA	DEST+12
	STA	DEST+32
	LXI	H,BSIZE		; Get Buffer allocated size
	SHLD	OUTSIZ		; Set for comparison
	MVI	C,DELET		; Delete any existing file that name
	LXI	D,DEST
	CALL	BDOS
	MVI	C,MAKE		; Now make a new file that name
	LXI	D,DEST
	CALL	BDOS
	INR	A
	JZ	NOROOM		; Cannot open file, no directory room
	CALL	DILPRT
	DB	CR,LF,'Wait a moment...',0
;
; Read sector from source file
;
READLP:	LXI	D,TBUF
	MVI	C,SETDMA
	CALL	BDOS
	LXI	D,FILE		; Read from WHATSFOR.TXT
	MVI	C,READ
	CALL	BDOS
	ORA	A		; Read ok?
	JNZ	RERROR
	LXI	H,TBUF		; Read buffer address
;
; Write sector to output file (with buffering)
;
WRDLOP:	MOV	A,M		; Get byte from read buffer
	ANI	7FH		; Strip parity bit
	CPI	7FH		; Del (rubout)?
	JZ	NEXT		; Yes, ignore it
	CPI	EOF		; End of file marker?
	JZ	TDONE		; Transfer done, close, exit
	CALL	OUTCHR
;
NEXT:	INR	L		; Done with sector?
	JZ	READLP		; If yes get another sector
	JMP	WRDLOP		; No, get another byte
;
; Handle a backspace character while entering a character string
;
BCKSP:	CALL	TYPE
	MOV	A,B		; Get position on line
	ORA	A
	JNZ	BCKSP1		; Exit if at initial column
	CALL	SENBEL		; Send a bell to the modem
	MVI	A,' '		; Delete the character
	JMP	BCKSP3
;
BCKSP1:	DCR	B		; Show one less column used
	DCX	H		; Decrease buffer location
	MVI	A,' '
	MOV	M,A		; Clear memory at this point
	CALL	TYPE		; Backspace the "CRT"
;
BCKSP2:	MVI	A,BS		; Reset the "CRT" again
;
BCKSP3:	CALL	TYPE		; Write to the "CRT"
	RET
;
; Asks for line of information
;
DESC:	MVI	B,0
	LXI	H,OLINE
;
DESC1:	CALL	INPUT		; Get keyboard character
	CPI	CR
	JZ	DESC4
	CPI	TAB
	JZ	DESC6
	CPI	BS
	JNZ	DESC2
	CALL	BCKSP
	JMP	DESC1		; Get the next character
;
DESC2:	CPI	' '
	JC	DESC1		; If non-printing character, ignore
	JZ	DESC3		; If a space, continue
	STA	ANYET		; Show a character has been sent now
;
DESC3:	MOV	M,A
	CALL	TYPE		; Display the character
	INX	H
	INR	B
	MOV	A,B
	CPI	70		; Do not exceed line length
	JC	DESC1
	CALL	SENBEL		; Send a bell to the modem
	CALL	BCKSP2
	CALL	BCKSP1		; Do not allow a too-long line
	JMP	DESC1
;
DESC4:	LDA	ANYET		; Any text typed on first line yet?
	ORA	A
	JNZ	DESC5		; If yes, exit
	POP	H
	JMP	ASK1		; Ask again for a description
;
DESC5:	MVI	M,CR
	MOV	A,M
	CALL	TYPE
	INX	H		; Ready for next character
	MVI	M,LF
	MOV	A,M
	CALL	TYPE		; Display the line feed
	INX	H
	MOV	A,B		; See if at first of line
	ORA	A
	RNZ			; If not, ask for next line
	POP	H		; Clear "CALL" from stack
	JMP	EXPL1
;
DESC6:	MOV	A,B		; At end of line now?
	CPI	68
	JNC	DESC1		; If yes, disregard
	MVI	M,' '
	MOV	A,M
	CALL	TYPE
	INX	H
	INR	B
	MOV	A,B
	ANI	7
	JNZ	DESC6
	JMP	DESC1		; Ask for next character
;
DSTOR:	LXI	H,OLINE
;
DSTOR1:	MOV	A,M
	CALL	OUTCHR
	CPI	LF
	RZ
	INX	H
	JMP	DSTOR1
;
; Print message then exit to CP/M
;
DEXIT:	POP	D		; Get message address
	MVI	C,PRINT		; Print message
	CALL	BDOS
	CALL	RESET		; Reset the drive/user
	JMP	EXIT		; all done
;
; Inline print routine - prints string pointed to by stack until a zero
; is found.  Returns to caller at the next address after the zero ter-
; minator.
;
DILPRT:	XTHL			; Save hl, get message address
;
DILPLP:	MOV	A,M		; Get char
	CALL	TYPE		; Output it
	INX	H		; Point to next
	MOV	A,M		; Test
	ORA	A		; For end
	JNZ	DILPLP
	XTHL			; Restore hl, ret address
	RET			; Return past the end of the message
;
;
; Disk is full, save original file, erase others.
;
FULL:	MVI	C,DELET
	LXI	D,DEST
	CALL	BDOS
	CALL	DEXIT
	DB	CR,LF,'++ DISK FULL, ABORTING, SAVING ORIGINAL FILE','$'
;
; Get a character, if none ready wait up to 3 minutes, then abort pgm
;
INPUT:	PUSH	H		; Save current values
	PUSH	D
	PUSH	B
;
INPUT1:	LXI	D,1200		; Outer loop count (about 2 minutes)
;
INPUT2:	LXI	B,MHZ*100	; Roughly 100 ms.
;
INPUT3:	PUSH	D		; Save the outer delay count
	PUSH	B		; Save the inner delay count
	MVI	E,0FFH
	MVI	C,DIRCON	; Get console status
	CALL	BDOS
	ANI	7FH
	POP	B		; Restore the inner delay count
	POP	D		; Restore the outer delay count
	ORA	A		; Have a character yet?
	JNZ	INPUT4		; If yes, exit and get it
	DCX	B
	MOV	A,C		; See if inner loop is finished
	ORA	B
	JNZ	INPUT3		; If not loop again
	DCX	D
	MOV	A,E
	ORA	D
	JNZ	INPUT2		; If not reset inner loop and go again
	MVI	A,CR
	CALL	OUTCHR
	MVI	A,LF
	CALL	OUTCHR
	LXI	SP,STACK	; Restore the stack
	CALL	EXPL3		; Finish appending previous information
	JMP	EXIT		; Finished
;
INPUT4:	POP	B
	POP	D
	POP	H
	RET
;
; Stores the Filename/extent in the buffer temporarily
;
LOPFCB:	LDAX	D		; Get FCB FILENAME/EXT character
	CPI	' '+1
	JC	LOPF1
	MOV	M,A		; Store in OLINE area
	CALL	TYPE		; Display on CRT
	INX	H		; Next OLINE position
;
LOPF1:	INX	D		; Next FCB position
	DCR	B		; One less to go
	JNZ	LOPFCB		; If not done, get next one
	RET
;
; No room to open a new file
;
NOROOM:	CALL	DEXIT
	DB	CR,LF,'++ No DIR space: output ++$'
;
; Output error - cannot close destination file
;
OERROR:	CALL	DEXIT
	DB	CR,LF,'++ Cannot close output ++$'
;
; Output a character to the new file buffer - first, see if there is
; room in the buffer for this character.
;
OUTCHR:	PUSH	H
	PUSH	PSW		; Store the character for now
	LHLD	OUTSIZ		; Get buffer size
	XCHG			; Put in 'DE'
	LHLD	OUTPTR		; Now get the buffer pointers
	MOV	A,L		; Check to see if room in buffer
	SUB	E
	MOV	A,H
	SBB	D
	JC	OUT3		; If room, go store the character
	LXI	H,0		; Otherwise reset the pointers
	SHLD	OUTPTR		; Store the new pointer address
;
OUT1:	XCHG			; Put pointer address into 'DE'
	LHLD	OUTSIZ		; Get the buffer size into 'HL'
	MOV	A,E		; See if buffer is max. length yet
	SUB	L		; By subtracting 'HL' from 'DE'
	MOV	A,D
	SBB	H
	JNC	OUT2		; If less, exit and keep going
;
; No more room in buffer, stop and transfer to destination file
;
	LHLD	OUTADR		; Get the buffer address
	DAD	D		; Add pointer value
	XCHG			; Put into 'DE'
	MVI	C,SETDMA
	CALL	BDOS
	LXI	D,DEST
	MVI	C,WRITE
	CALL	BDOS
	ORA	A
	JNZ	FULL		; Exit with error, if disk is full now
	LXI	D,RLEN
	LHLD	OUTPTR
	DAD	D
	SHLD	OUTPTR
	JMP	OUT1
;
OUT2:	LXI	D,TBUF
	MVI	C,SETDMA
	CALL	BDOS
	LXI	H,0
	SHLD	OUTPTR
;
OUT3:	XCHG
	LHLD	OUTADR
	DAD	D
	XCHG
	POP	PSW		; Get the character back
	STAX	D		; Store the character
	LHLD	OUTPTR		; Get the buffer pointer
	INX	H		; Increment them
	SHLD	OUTPTR		; Store the new pointer address
	POP	H
	RET
;
RERROR:	CPI	1		; File finished?
	JZ	TDONE		; Exit, then
	MVI	C,DELET		; Erase destination file, keep original
	LXI	D,DEST
	CALL	BDOS
	CALL	DEXIT
	DB	'++ Source file read error ++$'
;
; Reset the Drive/User to original, then back to original caller
;
RESET:	LDA	DRUSER		; Get original drive/user area back
	RAR
	RAR
	RAR
	RAR
	ANI	0FH		; Just look at the user area
	MOV	E,A
	MVI	C,SETUSR	; Restore original user area
	CALL	BDOS
	LDA	DRUSER		; Get the original drive/user back
	ANI	0FH		; Just look at the drive for now
	MOV	E,A
	MVI	C,SELDSK	; Restore original drive
	CALL	BDOS
	CALL	DILPRT		; Print CRLF before quitting
	DB	CR,LF,0
	RET			; Return to caller (Not JMP EXIT1)
;
; Send a bell just to the modem
;
SENBEL:	CALL	SNDRDY		; Is modem ready for another character?
	JNZ	SENBEL		; If not, wait
	MVI	A,7
	PUSH	PSW		; Overlay has the "POP PSW"
	JMP	SENDR		; Send to the modem only
;
;.....
;
;
; Shows the Filename/extent
;
SHONM:	CALL	DILPRT
	DB	CR,LF,CR,LF,0
	LXI	H,FCB+1
	MVI	B,8		; Maximum size of file name
	CALL	SHONM1
	MOV	A,M		; Get the next character
	CPI	' '		; Any file extent?
	RZ			; If not, finished
	MVI	A,'.'
	CALL	TYPE
	MVI	B,3		; Maximum size of file extent
;
SHONM1:	MOV	A,M		; Get FCB FILENAME/EXT character
	CPI	' '+1		; Skip any blanks
	JC	$+6
	CALL	TYPE		; Display on CRT
	INX	H		; Next FCB position
	DCR	B		; One less to go
	JNZ	SHONM1		; If not done, get next one
	RET
;.....
;
; Transfer is done - close destination file
;
TDONE:	LHLD	OUTPTR
	MOV	A,L
	ANI	RLEN-1
	JNZ	TDONE1
	SHLD	OUTSIZ
;
TDONE1:	MVI	A,EOF		; Fill remainder of record with ^Z's
	PUSH	PSW
	CALL	OUTCHR
	POP	PSW
	JNZ	TDONE
	MVI	C,CLOSE		; Close WHATSFOR.TXT file
	LXI	D,FILE
	CALL	BDOS
	MVI	C,CLOSE		; Close WHATSFOR.$$$ file
	LXI	D,DEST
	CALL	BDOS
	INR	A
	JZ	OERROR
;
;  Rename both files as no destination file name was specified
;
	LXI	H,FILE+1	; Prepare to rename old file to new
	LXI	D,DEST+17
	MVI	B,16
	CALL	MOVE
	MVI	C,DELET		; Delete original WHATSFOR.TXT file
	LXI	D,FILE
	CALL	BDOS
	LXI	D,DEST		; Rename WHATSFOR.$$$ to WHATSFOR.TXT
	MVI	C,RENAME
	CALL	BDOS
	JMP	RESET		; Reset the drive/user, back to caller
;
TYPE:	PUSH	B
	PUSH	D
	PUSH	H
	PUSH	PSW
	MOV	E,A		; Character to 'E' for CP/M
	MVI	C,WRCON		; Write to console
	CALL	BDOS
	POP	PSW
	POP	H
	POP	D
	POP	B
	RET
	 ENDIF	; DESCRIB
;
	 IF	DESCRIB	AND ASKIND
DKIND:	LDAX	D		; Get the character from the string
	CALL	TYPE		; Otherwise display the character
	MOV	M,A		; Put in the buffer
	CPI	LF		; Done yet?
	JZ	DKIND1		; Exit if a LF, done
	INX	D		; Next position in the string
	INX	H		; Next postion in the buffer
	JMP	DKIND		; Keep going until a LF
;
DKIND1:	LDA	KIND		; Get the kind of file back
	RET			; Finished
	 ENDIF
;.....
;
;-----------------------------------------------------------------------
;
; Send a character to the modem
;
SEND:	PUSH	PSW		; Save the character
	CALL	UPDCRC		; Calculate CRC
	ADD	C		; Calcculate checksum
	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
;
; 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.
; Since 1K extensions require CRC, KFLAG is set to NULL if the receiver
; requests checksum
;
WAITNAK: IF	CONFUN		; Check for Sysop function key?
	CALL	FUNCHK		; Yeah, go ahead.. Twit?
	 ENDIF
;
	 IF	CONFUN AND SYSABT
	LDA	SYSABF		; If SYSABT option, check
	ORA	A		; to see if Abort
	JNZ	ABORT		; If so, bail out now...
	 ENDIF
;
	MVI	B,1		; Timeout delay
	CALL	RECV		; Did we get
	CPI	'K'		; Did he send a "K" first?
	JZ	SET1KX
	CPI	CRC		; 'CRC' indicated?
	JZ	SET1K		; 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
;
; Turn on checksum flag
;
SETNAK:	XRA	A
	STA	KFLAG		; Make sure transfer uses small blocks
	MVI	A,'C'		; Change to checksum
	STA	CRCFLG
	RET
;
; Turn on 1k flag
;
SET1K:	MVI	B,1		; Wait up to 1 second to get "K"
	CALL	RECV
	CPI	'K'		; Did we get a "K" or something else
	RNZ			; (or nothing)
;
SET1KX:	LDA	MSPEED
	CPI	5
	RC
	MVI	A,'K'
	STA	KFLAG		; Set 1k flag
	RET
;
; 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 character
	MOV	A,M
	CPI	' '
	JZ	NOEXT		; No extent, make one
	CPI	'L'		; Check 1st character in extent
	JNZ	LBRERR
	INX	H
	MOV	A,M
	CPI	'B'		; Check 2nd character in extent
	JNZ	LBRERR
	INX	H
	MOV	A,M
	CPI	'R'		; Check 3rd character 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	TBUF+2		; Start location of 1st command
	MOV	B,A		; Store for now
	LDA	TBUF		; 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	ILPRT
	DB	CR,LF,'++ No library member file requested ++',CR,LF,0
	JMP	OPTERR
;
; 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 'TBUF' command line buffer into FCB
;
MOVENAM:MVI	C,1
;
MOVEN1:	MOV	A,M
	CPI	' '+1		; Name ends with space or return
	JC	FILLSP		; Fill with spaces if needed
	CPI	'.'
	JZ	CHKFIL		; File name might be less than 8 chars.
	STAX	D		; Store
	INX	D		; Next position to store the character
	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	OPTERR		; End of name, see if done yet
	JMP	MOVEN1
;
; See if any spaces needed between file name and .ext
;
CHKFIL:	CALL	FILLSP		; Fill with spaces
	JMP	MOVEN2
;
FILLSP:	MOV	A,C
	CPI	9
	RNC			; Up to 1st character in .ext now
	MVI	A,' '		; Be sure there is a blank there now
	STAX	D
	INR	C
	INX	D
	JMP	FILLSP		; Go do another
;
CTYPE:	PUSH	B		; Save all registers
	PUSH	D
	PUSH	H
	MOV	E,A		; Character 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
;
NIBBL:	ANI	0FH		; Isolate digit
	ADI	90H
	DAA
	ACI	40H
	DAA
	JMP	CTYPE		; Type it
;
; Inline print of message, terminates with a 0
;
ILPRT:	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
;
; Exit printing message following call
;
ERXIT:	CALL	ILPRT
	DB	CR,LF,0
	XRA	A
	STA	OPTSAV		; Reset option to zero for TELL
;
ERXIT1:	MVI	C,DIRCON	; Use BDOS Direct
	MVI	E,0FFH		; Console input function
	CALL	BDOS		; To check for abort
	CPI	'C'-40H		; CTL-C
	JZ	ERXITX		; Abort msg
	CPI	'K'-40H		; CTL-K
	JZ	ERXITX		; Abort msg
	POP	H		; Get address of next char
	MOV	A,M		; Get char
	INX	H		; Increment to next char
	PUSH	H		; Save address
	CPI	'$'		; End of message?
	JZ	EXITXL		; If '$' is end of message
	CALL	CTYPE		; Else print char on console
	JMP	ERXIT1		; And repeat until abort/end
;
EXITXL:	CALL	ILPRT
	DB	CR,LF,0
;
ERXITX:	POP	H		; Restore stack
	JMP	EXIT		; Get out of here
;
; Restore the old user area and drive from a received file
;
RECAREA:CALL	RECDRV		; Ok set the drive to its place
	LDA	PRVTFL		; Private area wanted?
	ORA	A
	LDA	XPRUSR		; Yes, set to private area
	JNZ	RECARE
	LDA	XUSR		; Ok now set the user area
;
RECARE:	MOV	E,A		; Stuff it in E
	MVI	C,SETUSR	; Tell BDOS what we want to do
	CALL	BDOS		; Now do it
	RET
;
RECDRV:	LDA	PRVTFL
	ORA	A
	LDA	XPRDRV		; Get private upload drive
	JNZ	RECDR1
	LDA	XDRV		; Or forced upload drive
;
RECDR1:	SUI	'A'		; Adjust it
;
RECDRX:	MOV	E,A		; Stuff it in E
	MVI	C,SELDSK	; Tell BDOS
	CALL	BDOS
	RET
;
MOVE:	MOV	A,M		; Get a character
	STAX	D		; Store it
	INX	H		; To next 'from'
	INX	D		; To next 'to'
	DCR	B		; More?
	JNZ	MOVE		; Yes, loop
	RET
;
;-----------------------------------------------------------------------
;
;			CRC SUBROUTINES
;
;-----------------------------------------------------------------------
;
CHKCRC:	PUSH	H		; Check 'CRC' bytes of received message
	LHLD	CRCVAL
	MOV	A,H
	ORA	L
	POP	H
	RZ
	MVI	A,0FFH
	RET
;
CLRCRC:	PUSH	H		; Reset 'CRC' store for a new message
	LXI	H,0
	SHLD	CRCVAL
	POP	H
	RET
;
FINCRC:	PUSH	PSW		; Finish 'CRC' calculation
	XRA	A
	CALL	UPDCRC
	CALL	UPDCRC
	PUSH	H
	LHLD	CRCVAL
	MOV	D,H
	MOV	E,L
	POP	H
	POP	PSW
	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
;
;		       end of CRC routines
;-----------------------------------------------------------------------
;		    start of LOGCAL routines
;
; The following allocations are used by the LOGCALL routines
;
	 IF	LOGCAL
PGSIZE:	DB	0,0,0		; Program length in minutes and seconds
LOGOPT:	DB	'?'		; Primary option stored here
DEFAULT$DISK:
	DB	0		; Disk for open stored here
DEFAULT$USER:
	DB	0		; User for open stored here
FCBCALLER:
	DB	0,'LASTCALR???'	; Last caller file FCB
	DB	0,0,0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0
CALLERPTR:
	DW	LOGBUF
FCBLOG:	DB	0		; Log file FCB
	 ENDIF
;
	 IF	LOGCAL AND NOT (LOGSYS OR KNET)
	DB	'XMODEM  '
	DB	'L','O'+80H,'G'	; (the +80H makes this a $SYS file)
	 ENDIF
;
	 IF	LOGCAL AND LOGSYS AND NOT KNET
	DB	'LOG     '
	DB	'S','Y'+80H,'S'
	 ENDIF
;
	 IF	LOGCAL AND KNET	AND NOT	LOGSYS
	DB	'XMODEM  '
	DB	'T','X'+80H,'#'
	 ENDIF
;
	 IF	LOGCAL
	DB	0,0,0,0,0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0
LOGPTR:	DW	DBUF
LOGCNT:	DB	0
LOGK:	DB	'k '
	 ENDIF
;
	 IF	LOGCAL OR MBFMSG OR MBDESC
DSKSAV:	DB	0		; Up/download disk saved here
USRSAV:	DB	0		; Up/download user saved here
	 ENDIF
;
	 IF	LOGCAL AND (RTC	OR B3RTC OR BYEBDOS)
YYSAV:	DB	0
MMSAV:	DB	0
DDSAV:	DB	0
MNSAV:	DB	0
	 ENDIF
;
; Main log file routine, adds record to log file
;
	 IF	LOGCAL OR MBDESC OR MBFMSG
LOGCALL:
	MVI	C,CURDRV	; Get current disk
	CALL	BDOS		; (where down/upload occurred)
	STA	DSKSAV		; And save it...
	MVI	C,SETUSR	; Get current user area
	MVI	E,0FFH		; (where down/upload occurred)
	CALL	BDOS
	STA	USRSAV		; And save it...
	 ENDIF
;
	 IF	(MBDESC	OR MBFMSG) AND (NOT LOGCAL)
	RET			; Skip logging if no log
	 ENDIF
;
	 IF	LOGCAL
	XRA	A
	STA	FCBCALLER+12
	STA	FCBCALLER+32
	MVI	A,LASTDRV-'A'
	STA	DEFAULT$DISK
	MVI	A,LASTUSR
	STA	DEFAULT$USER
	LXI	D,FCBCALLER
	CALL	OPENF		; Open LASTCALR file
	JNZ	LOGC1
	CALL	ERXIT
	DB	'++ No last caller file found +++$'
;
LOGC1:	MVI	C,SETRRD	; Get random record #
	LXI	D,FCBCALLER	; (for first record in file)
	CALL	BDOS
	LXI	D,DBUF		; Set DMA to DBUF
	MVI	C,SETDMA
	CALL	BDOS
	LXI	D,FCBCALLER	; Read first (& only) record
	MVI	C,RRDM
	CALL	BDOS
	 ENDIF	;LOGCAL
;
	 IF	LOGCAL AND NOT (MBBS AND (RTC OR B3RTC OR BYEBDOS))
	LXI	H,DBUF		; Set pointer to beginning of record
	 ENDIF
;
	 IF	LOGCAL AND (MBBS AND (RTC OR B3RTC OR BYEBDOS))
	LXI	H,DBUF+11	; Set pointer to skip log on date
	 ENDIF
;
	 IF	LOGCAL
	SHLD	CALLERPTR
	LXI	D,LOGBUF	; Set DMA address to LOGBUF
	MVI	C,SETDMA
	CALL	BDOS
	XRA	A
	STA	FCBLOG+12
	STA	FCBLOG+32
	MVI	A,LOGDRV-'A'
	STA	DEFAULT$DISK
	MVI	A,LOGUSR
	STA	DEFAULT$USER
	LXI	D,FCBLOG
	CALL	OPENF		; Open log file
	JNZ	LOGC4		; If file exists, skip create
	LXI	D,FCBLOG
	MVI	C,MAKE		; Create a new file if needed
	CALL	BDOS
	INR	A
	JNZ	LOGC2		; No error, cont.
	CALL	ERXIT		; File create error
	DB	'++ No dir space: log ++$'
;
LOGC2:	MVI	C,SETRRD	; Set random record #
	LXI	D,FCBLOG	; (for first record in file)
	CALL	BDOS
;
LOGC3:	MVI	A,EOF
	STA	LOGBUF
	JMP	LOGC4B
;
LOGC4:	MVI	C,CFSIZE	; Get file length
	LXI	D,FCBLOG
	CALL	BDOS		; (end+1)
	LHLD	FCBLOG+33	; Back up to last record
	MOV	A,L
	ORA	H
	JZ	LOGC3		; Unless zero length file
	DCX	H
	SHLD	FCBLOG+33
	LXI	D,FCBLOG
	MVI	C,RRDM		; And read it
	CALL	BDOS
;
LOGC4B:	CALL	RSTLP		; Initialize LOGPTR and LOGCNT
;
LOGC6:	CALL	GETLOG		; Get characters out of last record
	CPI	EOF
	JNZ	LOGC6		; Until EOF
	LDA	LOGCNT		; Then backup one character
	DCR	A
	STA	LOGCNT
	LHLD	LOGPTR
	DCX	H
	SHLD	LOGPTR
	LDA	LOGOPT		; Get option back and put in file
	CALL	PUTLOG
	CALL	SPEED		; Get speed factor
	ADI	30H
	CALL	PUTLOG
	CALL	PUTSP		; Blank
	LDA	PGSIZE		; Now the program size in minutes..
	CALL	PNDEC		; Of transfer time (mins)
	MVI	A,':'
	CALL	PUTLOG		; ':'
	LDA	PGSIZE+2
	CALL	PNDEC		; And secs..
	CALL	PUTSP		; Blank
;
; Log the drive and user area as a prompt
;
	LDA	FCB
	ORA	A
	JNZ	WDRV
	LDA	DSKSAV
	INR	A
;
WDRV:	ADI	'A'-1
	CALL	PUTLOG
	LDA	USRSAV
	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 library
	MVI	B,11
	CALL	PUTSTR
	CALL	PUTSP		; ' '
;
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
	CALL	PUTSP		; Put ' '
	POP	B
	DCR	C
	JNZ	SPLOOP
	LHLD	VRECNO		; Get VIRTUAL record count
	LXI	D,8		; Divide record count by 8
	CALL	DVHLDE		; To get # of 1024 byte blocks
	MOV	A,H
	ORA	L		; Check if remainder
	MOV	H,B		; Get quotient
	MOV	L,C
	JZ	EXKB2		; If 0 remainder, exact kb
	INX	H		; Else increment to next kb
;
EXKB2:	CALL	PNDEC3		; Print to log file (right just xxxk)
	LXI	H,LOGK		; 'k '
	MVI	B,2
	CALL	PUTSTR
	 ENDIF
;
	 IF	LOGCAL AND BYEBDOS
	MVI	C,BDSTOS	; Set max time to 0 so BYE won't
	MVI	E,0		; hang up when doing BYEBDOS calls
	CALL	BDOS		; when getting time/date
	 ENDIF
;
	 IF	LOGCAL AND (B3RTC OR RTC OR BYEBDOS)
	CALL	GETDATE		; IF RTC, get current date
	PUSH	B		; (save DD/YY)
	CALL	PNDEC		; Print MM
	MVI	A,'/'		; '/'
	CALL	PUTLOG
	POP	PSW		; Get DD/YY
	PUSH	PSW		; Save YY
	CALL	PNDEC		; Print DD
	MVI	A,'/'		; '/'
	CALL	PUTLOG
	POP	B		; Get YY
	MOV	A,C
	CALL	PNDEC		; Print YY
	CALL	PUTSP		; ' '
	CALL	GETTIME		; IF RTC, get current time
	STA	MNSAV		; Save min
	MOV	A,B		; Get current hour
	CALL	PNDEC		; Print hr to file
	MVI	A,':'		; With ':'
	CALL	PUTLOG		; Between HH:MM
	LDA	MNSAV		; Get min
	CALL	PNDEC		; And print min
	CALL	PUTSP		; Print a space
	 ENDIF
;
	 IF	LOGCAL AND BYEBDOS
	LDA	MAXTOS		; Reset time on system
	MOV	E,A		; So BYE will hang up
	MVI	C,BDSTOS	; If caller is over time limit
	CALL	BDOS
	 ENDIF
;
	 IF	LOGCAL AND OXGATE AND (B3RTC OR	RTC OR BYEBDOS)
	XRA	A
	STA	CMMACNT		; Clear comma count
	 ENDIF
;
	 IF	LOGCAL
CLOOP:	CALL	GETCALLER	; 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
	 ENDIF	; LOGCAL
;
	 IF	LOGCAL AND OXGATE AND (B3RTC OR	RTC OR BYEBDOS)
	LDA	CMMACNT		; Get comma count
	INR	A
	STA	CMMACNT
	CPI	2		; If reached second comma, do CRLF exit
	JZ	CLOPX
	 ENDIF
;
	 IF	LOGCAL
	MVI	A,' '		; Instead send a ' '
CLOP2:	CALL	PUTLOG
	JMP	CLOOP
	 ENDIF
;
	 IF	LOGCAL AND OXGATE AND (B3RTC OR	RTC OR BYEBDOS)
CLOPX:	MVI	A,CR		; Cloop exit... do a CRLF and finish up.
	CALL	PUTLOG
	MVI	A,LF
	CALL	PUTLOG
	 ENDIF
;
	 IF	LOGCAL
QUIT:	MVI	A,EOF		; Put in EOF
	CALL	PUTLOG
	LDA	LOGCNT		; Check count of chars in buffer
	CPI	1
	JNZ	QUIT		; Fill last buffer & write it
	LXI	D,FCBCALLER	; Close lastcaller file
	MVI	C,CLOSE
	CALL	BDOS
	INR	A
	JZ	QUIT1
	LHLD	FCBLOG+33	; Move pointer back to show
	DCX	H		; Actual file size
	SHLD	FCBLOG+33
	LXI	D,FCBLOG	; Close log file
	MVI	C,CLOSE
	CALL	BDOS
	INR	A
	RNZ			; If OK, return now...
;
QUIT1:	CALL	ERXIT		; If error, oops
	DB	'++ Cannot close log ++$'
	 ENDIF	; LOGCAL
;
;-----------------------------------------------------------------------
;
; Support routines for LOGCAL
;
; Gets a single byte from DBUF
;
	 IF	LOGCAL
GETCALLER:
	LHLD	CALLERPTR
	MOV	A,M
	INX	H
	SHLD	CALLERPTR
	RET
;
; Gets a single byte from log file
;
GETLOG:	LDA	LOGCNT
	INR	A
	STA	LOGCNT
	CPI	129
	JZ	EOLF
	LHLD	LOGPTR
	MOV	A,M
	INX	H
	SHLD	LOGPTR
	RET
;
EOLF:	LHLD	FCBLOG+33
	INX	H
	SHLD	FCBLOG+33
	LXI	H,LOGBUF+1
	SHLD	LOGPTR
	MVI	A,1
	STA	LOGCNT
	MVI	A,EOF
	RET
;
; Open file with FCB pointed to by DE (disk/user passed in DEFAULT$DISK
; and DEFAULT$USER)
;
OPENF:	PUSH	D		; Save FCB address
	LDA	DEFAULT$DISK	; Get disk for file
	CALL	RECDRX		; Log into it
	LDA	DEFAULT$USER	; Get default user
	CALL	RECARE		; Log into it
	POP	D		; Get FCB address
	MVI	C,OPEN		; Open file
	CALL	BDOS
	CPI	255		; Not present?
	RET			; Return to caller
;
; Write character to log file
;
PUTLOG:	LHLD	LOGPTR		; Get pointer
	ANI	7FH		; Mask off any high bits
	MOV	M,A		; Put data
	INX	H		; Increment pointer
	SHLD	LOGPTR		; Update pointer
	MOV	B,A		; Save character in B
	LDA	LOGCNT		; Get count
	INR	A		; Increment it
	STA	LOGCNT		; Update count
	CPI	129		; Check it
	RNZ			; If not EOB, return
	PUSH	B		; Save character
	LXI	D,FCBLOG	; Else, write this sector
	MVI	C,WRDM
	CALL	BDOS
	ORA	A
	JZ	ADVRCP		; If ok, cont.
	CALL	ERXIT
	DB	'++ Disk full - cannot add to log ++$'
;
ADVRCP:	LHLD	FCBLOG+33	; Advance record number
	INX	H
	SHLD	FCBLOG+33
	CALL	RSTLP		; Reset buffer pointers
	POP	PSW		; Get saved character
	JMP	PUTLOG		; Put it in buffer and return
;
RSTLP:	LXI	H,LOGBUF	; Reset pointers
	SHLD	LOGPTR		; And return
	MVI	A,0
	STA	LOGCNT
	RET
;
; Print number in decimal format (into log file)
;    IN:  HL=binary number
;    OUT: nnn=right justified with spaces
;
PNDEC3:	MOV	A,H		; Check high byte
	ORA	A
	JNZ	DECOT		; If on, is at least 3 digits
	MOV	A,L		; Else, check low byte
	CPI	100
	JNC	TEN
	CALL	PUTSP
;
TEN:	CPI	10
	JNC	DECOT
	CALL	PUTSP
	JMP	DECOT
;
; Puts a single space in log file, saves PSW/HL
;
PUTSP:	PUSH	PSW
	PUSH	H
	MVI	A,' '
	CALL	PUTLOG
	POP	H
	POP	PSW
	RET
;
; Print number in decimal format (into log file)
;
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
;
; Put string to log file
;
PUTSTR:	MOV	A,M
	PUSH	H
	PUSH	B
	CALL	PUTLOG
	POP	B
	POP	H
	INX	H
	DCR	B
	JNZ	PUTSTR
	RET
	 ENDIF	; LOGCAL
;
;		      end of LOGCAL routine
;-----------------------------------------------------------------------
;		     start of TIMEON routine
;
; Calculate time on system and inform user.  Log him off if =>MAXMIN
; unless STATUS is non-zero.
;
	 IF	TIMEON
TIME:	PUSH	B		; Save BC pair
	CALL	GETTIME		; Get time from system's RTC
	STA	CMTEMP		; Save in current-hour-temp
	MOV	A,B		; Get current hour
	POP	B		; Restore BC
	 ENDIF
;
	 IF	TIMEON AND BYEBDOS
	PUSH	PSW		; save the current hour <== BUG FIX
	PUSH	B		; Lhour was safely moved to highmem
	PUSH	D		; in newer versions of BYE
	MVI	C,BDGRTC
	CALL	BDOS
	LXI	D,11		; Get address of LHOUR
	DAD	D
	POP	D
	POP	B
	POP	PSW		; Restore current hour...BDOS killed it
	 ENDIF
;
	 IF	TIMEON AND NOT BYEBDOS
	LXI	H,LHOUR		; Point to log-on hour (in low memory)
	 ENDIF
;
	 IF	TIMEON
	CMP	M		; Equal?
	INX	H		; Point to logon minutes
	JNZ	TIME1		; No
	MOV	D,M
	LDA	CMTEMP		; Current minutes
	SUB	D
	STA	TON		; Store total time on
	JMP	TIME2
;
TIME1:	MOV	D,M		; Get logon minutes
	MVI	A,03CH		; 60 min into A
	SUB	D
	LXI	H,CMTEMP	; Point at current min
	ADD	M		; Add current minutes
	STA	TON
	 ENDIF
;
TIME2:	 IF	ZCPR2 AND TIMEON
	LDA	WHEEL		; Check wheel status if ZCPR
	ORA	A		; Is it zero
	JNZ	TIME3		; If not then this is a special user
	 ENDIF
;
	 IF	TIMEON
	LDA	MAXTOS
	ORA	A		; If maxtos is zero, guy is superuser
	JZ	TIME3
	 ENDIF
;
	 IF	TIMEON AND NOT BYEBDOS ; BYEBDOS doesn't use status byte
	ORA	A		; Special user?
	JNZ	TIME3		; Yes, skip log off check
	LDA	TON
	SUI	MAXMIN		; Subtract max time allowed
	 ENDIF
;
	 IF	TIMEON AND BYEBDOS
	LDA	MAXTOS
	MOV	B,A
	LDA	TON
	SUB	B
	 ENDIF
;
	 IF	TIMEON
	JC	TIME3		; Still time left
	CALL	TIMEUP		; Time is up, inform user
	MVI	A,0CDH		; Alter jump vector
	STA	0		; At zero
	JMP	0000H		; And log him off
;
TIME3:	LXI	H,MSG1+015H	; Point at message insert bytes
	LDA	TON		; Convert to ASCII
	MVI	B,0FFH
;
TIME4:	INR	B
	SUI	0AH		; Subtract 10
	JNC	TIME4		; Until done
	ADI	0AH
	ORI	'0'		; Make ASCII
	MOV	M,A
	DCX	H
	MVI	A,'0'
	ADD	B
	MOV	M,A
	CALL	ILPRT
;
MSG1:	DB	CR,LF,'Time on system is 00 minutes',CR,LF,0
	 ENDIF
;
	 IF	TIMEON AND NOT BYEBDOS
	LDA	STATUS		; Check user status
	ORA	A		; Special user?
	JNZ	TIME5		; Yes, reset TON
	 ENDIF
;
	 IF	TIMEON
	RET
	 ENDIF
;
	 IF	TIMEON AND NOT BYEBDOS
TIME5:	MVI	A,0		; Reset timeout for good guys
	STA	TON
	RET
	 ENDIF
;
	 IF	TIMEON
TIMEUP:	CALL	ILPRT
	DB	CR,LF,CR,LF
	DB	'Your time is up - wait 24 hours to call back',CR,LF,0
	RET
;
TON:	DB	0		; Storage for time on system
CMTEMP:	DB	0		; Storage for current minute value
	 ENDIF
;
; Get caller's time on system from BYE3 or MBYE and display on console.
;
	 IF	B3RTC AND B3TOS
TIME:	CALL	ILPRT
	DB	CR,LF,'Time on system is ',0
	CALL	GETTOS		; Get Time On System from MBYE's RTC
	CALL	DECOUT		; Print it on the screen
	CALL	ILPRT
	DB	' minutes',CR,LF,0
	RET
	 ENDIF
;
; Get caller's time on system (returned in HL).
;
	IF	B3RTC AND (NOT BYEBDOS)
GETTOS:	LHLD	RTCBUF		; Get RTCBUF addr
	MOV	A,H
	ORA	L
	RZ			; If 0000H, BYE not running so TOS=0
	MOV	A,M		; If hours = 99
	CPI	099H
	LXI	H,0
	RZ			; Return with TOS=0
	LHLD	RTCBUF
	LXI	D,B3CMOS	; Get offset to TOS word
	DAD	D		; (addr in HL)
	MOV	E,M		; Get minutes on system
	INX	H
	MOV	D,M		; Stuff into DE
	XCHG			; Swap into HL
	RET
	ENDIF
;
	 IF	BYEBDOS	OR MXTOS
MAXTOS:	DB	0		; Maximum time on system
	 ENDIF
;
;		      end of TIMEON routine
;-----------------------------------------------------------------------
;
GETDATE: IF	(RTC AND LOGCAL) AND NOT (CPM3 OR BYEBDOS)
	LDA	45H		; Get the binary day number
	MOV	B,A		; Set to return binary day # B reg.
	LDA	46H		; Get the binary year number
	MOV	C,A		; Set to return binary year # in C reg.
	LDA	44H		; Get the binary month number
	RET
	 ENDIF
;
;-----------------------------------------------------------------------
;		   start of CPM+ date routine

	 IF	RTC AND	LOGCAL AND CPM3
	MVI	C,GETTIM	; BDOS function to get date and time
	LXI	D,TIMEPB	; Get address of 4-byte data structure
	CALL	BDOS		; Transfer the current date/time
	LHLD	TIMEPB
	MVI	B,78		; Set years counter
;
LOOP:	CALL	CKLEAP
	LXI	D,-365		; Set up for subtract
	JNZ	NOLPY		; Skip if no leap year
	DCX	D		; Set for leap year
;
NOLPY:	DAD	D		; Subtract
	JNC	YDONE		; Continue if years done
	MOV	A,H
	ORA	L
	JZ	YDONE
	SHLD	TIMEPB		; Else save days count
	INR	B		; Increment years count
	JMP	LOOP		; And do again
;
; The years are now finished, the years count is in 'B' and TIMEPB holds
; the days (HL is invalid)
;
YDONE:	MOV	A,B
	STA	YEAR
	CALL	CKLEAP		; Check if leap year
	MVI	A,-28
	JNZ	FEBNO		; February not 29 days
	MVI	A,-29		; Leap year
;
FEBNO:	STA	FEB		; Set february
	LHLD	TIMEPB		; Get days count
	LXI	D,MTABLE	; Point to months table
	MVI	B,0FFH		; Set up 'B' for subtract
	MVI	A,0		; Set a for # of months
;
MLOOP:	PUSH	PSW
	LDAX	D		; Get month
	MOV	C,A		; Put in 'C' for subtract
	POP	PSW
	SHLD	TIMEPB		; Save days count
	DAD	B		; Subtract
	INX	D		; Increment months counter
	INR	A
	JC	MLOOP		; Loop for next month
;
; The months are finished, days count is on stack.  First, calculate
; the month.
;
MDONE:	MOV	B,A		; Save months
	LHLD	TIMEPB
	MOV	A,H
	ORA	L
	JNZ	NZD
	DCX	D
	DCX	D
	LDAX	D
	CMA
	INR	A
	MOV	L,A
	DCR	B
;
NZD:	MOV	A,B
	STA	MONTH
	MOV	A,L
	STA	DAY
	LDA	YEAR
	MOV	C,A
	LDA	DAY
	MOV	B,A
	LDA	MONTH
	RET
;
; This routine checks for leap years.
;
CKLEAP:	MOV	A,B
	ANI	0FCH
	CMP	B
	RET
;
; This is the month's table
;
MTABLE:	DB	-31		; January
FEB:	DB	-28		; February
	DB	-31,-30,-31,-30	; Mar-Jun
	DB	-31,-31,-30	; Jul-Sep
	DB	-31,-30,-31	; Oct-Dec
;
YEAR:	DB	0
MONTH:	DB	0
DAY:	DB	0
	 ENDIF	; RTC AND LOGCAL AND CPM3
;
;		    end of CPM+ date routine
;-----------------------------------------------------------------------
;
	 IF	LOGCAL AND B3RTC AND NOT BYEBDOS
	CALL	BYECHK		; See if BYE is running
	JZ	GETBDAT		; If so, get date from buffer & convert
	MVI	A,0		; Else, return 00/00/00
	MOV	B,A
	MOV	C,A
	RET
	 ENDIF
;
	 IF	LOGCAL AND B3RTC AND (NOT BYEBDOS)
GETBDAT:LHLD	RTCBUF		; Get RTC buffer in HL
	 ENDIF
;
	 IF	LOGCAL AND BYEBDOS AND (NOT B3RTC)
	MVI	C,BDGRTC	; Get RTC buffer in HL
	CALL	BDOS
	 ENDIF
;
	 IF	LOGCAL AND (BYEBDOS OR B3RTC)
	LXI	D,4		; Offset to YY
	DAD	D		; HL=YY Address
	MOV	A,M		; Get YY
	CALL	BCDBIN		; Make it binary
	STA	YYSAV		; Save YY
	INX	H		; Point to MM
	MOV	A,M		; Get MM
	CALL	BCDBIN		; Convert BCD to binary
	STA	MMSAV		; Save it
	INX	H		; Point to DD
	MOV	A,M		; Get DAY
	CALL	BCDBIN		; Convert it to binary
	MOV	B,A		; Stuff DD in B
	LDA	YYSAV		; Get YY
	MOV	C,A		; Put YY in C
	LDA	MMSAV		; Get MM in A
	RET			; And return
	 ENDIF
;
;
; The routine here should read your real-time clock and return with the
; following information:
;
; register: A - current minute (0-59)
;	    B - current hour   (0-23)
;
GETTIME: IF	(TIMEON	OR RTC)	AND NOT	(B3RTC OR CPM3 OR BYEBDOS)
;
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;	     (this example is for the Serria SBC-100)
;;
;;SBCHR EQU	040H		; Low memory area where stored
;;SBCMN EQU	041H
;;
;;	LDA	SBCHR		; Get hour from BIOS memory-clock
;;	MOV	B,A
;;	LDA	SBCMN		; Get minute from BIOS memory-clock
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;	(this example is for Don Brown's computer)
;;
;;	LDA	43h		; Get the current binary hour number
;;	MOV	B,A		; Set to return binary hour number in Reg. B
;;	LDA	42h		; Get the current binary minute number
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
	RET
	 ENDIF
;
; The following code is for CP/M Plus
;
	 IF	(TIMEON	OR RTC)	AND CPM3
	MVI	C,GETTIM	; BDOS function to get date and time
	LXI	D,TIMEPB	; Get address of 4-byte data structure
	CALL	BDOS		; Transfer the current date/time
	LDA	TIMEPB+2	; Get current hour
	CALL	BCDBIN		; Convert BCD hour to binary
	MOV	B,A		; Position hour for return
	PUSH	B		; Save the binary hour
	LDA	TIMEPB+3	; Get current minute
	CALL	BCDBIN		; Convert BCD minute to binary
	POP	B		; Restore the binary hour
	RET
	 ENDIF
;
	 IF	LOGCAL AND B3RTC AND (NOT BYEBDOS)
	CALL	BYECHK		; See if BYE is running
	JZ	GETBTIM		; If so, get time from buffer & convert
	MVI	A,0		; Else, return 00:00
	MOV	B,A
	RET
;
GETBTIM:LHLD	RTCBUF		; Get RTC buffer address
	 ENDIF
;
	 IF	LOGCAL AND BYEBDOS AND (NOT B3RTC)
	MVI	C,BDGRTC	; Get RTC buffer address
	CALL	BDOS
	 ENDIF
;
	 IF	LOGCAL AND (B3RTC OR BYEBDOS)
	MOV	A,M		; Get hours on system
	CALL	BCDBIN		; Convert BCD value to binary
	PUSH	PSW		; Save hr on stack
	INX	H		; Point to minute
	MOV	A,M		; Get min
	CALL	BCDBIN		; Convert BCD to binary
	POP	B		; Get hr in B (min in A)
	RET			; And return
	 ENDIF
;
; Convert BCD value in A to binary in A
;
	 IF	LOGCAL AND (B3RTC OR CPM3 OR BYEBDOS)
BCDBIN:	PUSH	PSW		; Save A
	ANI	0F0H		; Mask high nibble
	RRC			; Move to low nibble
	RRC
	RRC
	RRC
	MOV	C,A		; And stuff in C (C=A)
	MVI	B,9		; X10 (*9)
;
BCDBL:	ADD	C		; Add orig value to A
	DCR	B		; Decrement B
	JNZ	BCDBL		; Loop nine times (A+(C*9)=A*10)
	MOV	B,A		; Save result in B
	POP	PSW		; Get original value
	ANI	0FH		; Mask low nibble
	ADD	B		; +B gives binary value of BCD digit A
	RET			; Return
	 ENDIF
;
; Check to see that HL register is at least 8 records.	If it not, make
; sure 1K blocks are turned off
;
CKKSIZ:	MOV	A,H		; Get high order byte
	ORA	A		; Something there?
	RNZ			; Yes, certainly more than 8
	MOV	A,L		; Get low order byte
	CPI	8		; Looking for at least this many records
	RNC			; Not Carry means 8 or more records
	XRA	A		; Get nothing
	STA	KFLAG		; Turn off 1K blocks
	RET
;
;-----------------------------------------------------------------------
;
;		    BYEBDOS access routines
;
;-----------------------------------------------------------------------
;
	 IF	BYEBDOS
CONOUT:	MOV	E,C		; Get character into E
	MVI	C,BDCONO	; Console output (local only)
	JMP	BDOS		; Go to it...
;
MINIT:
UNINIT:	RET			; Modem's already initialized
;
SENDR:	POP	PSW		; Needed by specifications
	PUSH	B
	PUSH	D
	PUSH	H
	MOV	E,A		; Put character in E
	MVI	C,BDMOUT
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	RET
;
GETCHR:
MDIN:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,BDMINP
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	RET
;
; The following 3 routines operate in differently than BYE does, so we
; must make things "backwards"
;
CAROK:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,BDCSTA
	CALL	BDOS
	JMP	BKWDS
;
RCVRDY:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,BDMIST
	CALL	BDOS
	JMP	BKWDS
;
SNDRDY:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,BDMOST
	CALL	BDOS
;
; Flip around bytes, if A>0 then make A zero & set flags
;		     if A=0 then make A =255 & set flags
BKWDS:	ORA	A
	MVI	A,255
	JZ	NOSIG
	XRA	A
;
NOSIG:	ORA	A
	POP	H
	POP	D
	POP	B
	RET
;
SPEED:	LDA	MSPEED
	RET
	 ENDIF
;
;-----------------------------------------------------------------------
;
;		     Temporary storage area
;
;-----------------------------------------------------------------------
;
	 IF	DESCRIB
FILE:	DB	0,'WHATSFORTXT',0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0
DEST:	DB	0,'        $$$',0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0,0,0,0,0,0,0
	 ENDIF
;
; Put this ram stuff in the RAM section at the end
;
LZFLG:	DB	0		; For the free space printer
BLKSHF:	DB	0
BLKMAX:	DB	0,0
;
	 IF	B3RTC AND NOT BYEBDOS	; If BYE3/MBYE real-time clock
RTCBUF:	DW	0		; Address of RTCBUF saved here
	 ENDIF
;
	 IF	B3RTC AND NOT (MBMXT OR	BYEBDOS)
TOSSAV:	DW	0
	 ENDIF
;
	 IF	LOGCAL AND OXGATE AND (B3RTC OR	RTC OR BYEBDOS)
CMMACNT:DB	0		; Comma counter
	 ENDIF
;
	 IF	TIMEON AND CPM3
TIMEPB:	DS	4		; Storage for the system date/time
	 ENDIF
;
MINUTE:	DW	0		; Transfer time in mins for MAXTIM
MEMFCB:	DB	'                ' ; Library name (16 bytes required)
ANYET:	DB	0		; Any description typed yet?
BLKSIZ:	DW	0		; Number of bytes, 128 or 1024
CONONL:	DB	0		; CTYPE console-only flag
CRCFLG:	DB	0		; Sets to 'C' if checksum requested
CRCVAL:	DW	0		; Current CRC value
DIRSZ:	DW	0		; Directory size
DRUSER:	DB	0		; Original drive/user, for return
DUD:	DB	0		; Specified disk
DUSAVE:	DB	0,0,0,0		; Buffer for drive/user
DUU:	DB	0		; Specified user
ERRCT:	DB	0		; Error count
FRSTIM:	DB	0		; Turned on after first 'SOH' received
INDEX:	DW	0		; Index into directory
KFLAG:	DB	0		; Non-zero if sending 1K blocks
OUTPTR:	DW	0
RCNT:	DW	0		; Record count
RCVDRV:	DB	0		; Requested drive number
RCVRNO:	DB	0		; Record number received
RCVUSR:	DB	0		; Requested user number
RECDNO:	DW	0		; Current record number
KIND:	DB	0		; Asks what kind of file this is
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
MSGFLG:	DB	0		; Message upload flag
SAVEHL:	DW	0		; Saves TBUF command line address
TOTERR:	DW	0		; Total errors for transmission attempt
VRECNO:	DW	0		; Virtual record # in 128 byte records
;
EOFLG:	DB	0		; 'EOF' flag (1=yes)
EOFCTR:	DB	0		; EOF send counter
OUTADR:	DW	LOGBUF
OUTSIZ:	DW	BSIZE
RECPTR:	DW	DBUF
RECNBF:	DW	0		; Number of records in the buffer
;
	 IF	CONFUN AND SYSABT
SYSABF:	DB	0		; set if sysop uses ^X to abort
	 ENDIF
;
	 IF	(DESCRIB OR MBDESC) AND	NDESC
NDSCFL:	DB	0		; Used to store "RN" option
	 ENDIF			; to bypass upload descriptions
;
	 IF	DESCRIB
HLINE:	DB	'-------------------',CR,LF
OLINE:	DS	80		; Temporary buffer to store line
	 ENDIF
;
	DS	80		; Minimum stack area
;
; Disk buffer
;
	ORG	($+127)/128*128
;
DBUF	EQU	$		; 16-record disk buffer
STACK	EQU	DBUF-2		; Save original stack address
LOGBUF	EQU	DBUF+128	; For use with LOGCAL
;
;-----------------------------------------------------------------------
;
;			  BDOS equates
;
;-----------------------------------------------------------------------
;
RDCON	EQU	1		; Get character from console
WRCON	EQU	2		; Output to console
DIRCON	EQU	6		; Direct console output
PRINT	EQU	9		; Print string function
VERNO	EQU	12		; Get CP/M version number
SELDSK	EQU	14		; Select drive
OPEN	EQU	15		; 0FFH = not found
CLOSE	EQU	16		; "	  "
SRCHF	EQU	17		; "	  "
SRCHN	EQU	18		; "	  "
DELET	EQU	19		; Delete file
READ	EQU	20		; 0=OK, 1=EOF
WRITE	EQU	21		; 0=OK, 1=ERR, 2=?, 0FFH=no dir. space
MAKE	EQU	22		; 0FFH=bad
RENAME	EQU	23		; Rename a file
CURDRV	EQU	25		; Get current drive
SETDMA	EQU	26		; Set DMA
SETATT	EQU	30		; Set file attributes
SETUSR	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
GETTIM	EQU	105		; CP/M Plus get date/time
BDOS	EQU	0005H
TBUF	EQU	0080H		; Default DMA address
FCB	EQU	005CH		; System FCB
FCBEXT	EQU	FCB+12		; File extent
FCBRNO	EQU	FCB+32		; Record number
RANDOM	EQU	FCB+33		; Random record field
;
;	Extended BYEBDOS equates
;
	 IF	BYEBDOS
BDMIST	EQU	61		; Modem raw input status
BDMOST	EQU	62		; Modem raw output status
BDMOUT	EQU	63		; Modem output 8 bit char
BDMINP	EQU	64		; Modem input 8 bit char
BDCSTA	EQU	65		; Modem carrier status
BDCONS	EQU	66		; Local console input status
BDCONI	EQU	67		; Local console input char
BDCONO	EQU	68		; Local console output char
BDMXDR	EQU	69		; Set/get maximum drive
BDMXUS	EQU	70		; Set/get maximum user area
BDNULL	EQU	72		; Set/get nulls
BDTOUT	EQU	71		; Set/get idle timeout
BDULCS	EQU	73		; Set/get upperlowercase switch
BDLFMS	EQU	74		; Set/get line-feed mask
BDHRDL	EQU	76		; Set/get hardlog
BDWRTL	EQU	75		; Set/get writeloc
BDMDMO	EQU	77		; Set/get mdmoff flag
BDBELL	EQU	78		; Set/get bell mask flag
BDGRTC	EQU	79		; Get address of rtc buffer
BDGLCB	EQU	80		; Get address of lc buffer
BDSTOS	EQU	81		; Maximum time on system
BDSLGT	EQU	82		; Set login time
BDPTOS	EQU	83		; Print Time on System
	 ENDIF			; BYEBDOS
;
	END