mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
5905 lines
143 KiB
5905 lines
143 KiB
;
|
|
; 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
|
|
;
|
|
; Add debugging code?
|
|
;
|
|
DEBUG EQU 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 10 ; Clock speed, use integer (2,4,5,8, etc.)
|
|
SCL EQU 6600 ; [WBW] Receive loop timeout scalar
|
|
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 NO ; Yes, change .COM to .OBJ on receive
|
|
NOCOMS EQU NO ; Yes, .COM files not sent
|
|
NOLBS EQU NO ; Yes, .??# files not sent
|
|
NOSYS EQU NO ; 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 16 ; Number of disk drives used (1=A, 2=B, etc)
|
|
MAXUSR EQU 16 ; 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 NO ; 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 NO ; Yes, using designated du: to receive files
|
|
; No, upload to currently logged du:
|
|
SPCDU EQU NO ; 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 'A' ; Private drive for SYSOP to receive file
|
|
PRUSR EQU 0 ; 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 'A' ; Special drive area for downloading SYSOP files
|
|
SPLUSR EQU 0 ; 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 NO ; 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 YES ; Yes, if modem patch area over 128 bytes
|
|
LARSIZE EQU 500H ; 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 NO ; 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
|
|
;
|
|
CALL SNDOPC
|
|
CALL SNDOPC
|
|
JMP ALLSET
|
|
SNDOPC:INX H ; Look for an option
|
|
MOV A,M
|
|
CPI ' ' ; Is it a space?
|
|
JNZ CHKK
|
|
POP PSW
|
|
JMP ALLSET
|
|
CHKK: CPI 'K'
|
|
JNZ CHK6TH ; If it's not K it should be a port number
|
|
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
|
|
RET ; 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
|
|
;
|
|
; [WBW] Added to support port number
|
|
CALL RCVOPC ; Check 5th (or 6th) option
|
|
;
|
|
JMP OPTERR ; If 7th or 8th 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 ; Nope, try next
|
|
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 CHK6TH ; Nope, try next
|
|
STA NDSCFL ; else set flag to skip descript phase
|
|
RET
|
|
ENDIF
|
|
;
|
|
CHK6TH:
|
|
; [WBW] Get target serial port (0-9 supported)
|
|
CPI '0'
|
|
JC BADROP ; If < 0, out of range
|
|
CPI '9' + 1
|
|
JNC BADROP ; If > 9, out of range
|
|
SUI '0' ; Make binary
|
|
STA PORT
|
|
RET
|
|
;
|
|
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
|
|
LDA PORT ; [WBW] Pass serial port to driver
|
|
CALL MINIT
|
|
STA CPUMHZ ; [WBW] Save CPU speed from MINIT
|
|
SHLD RCVSCL ; [WBW] Save rcv loop scalar from 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
|
|
DB ' Add "0"-"9" to specify serial port',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")',CR,LF
|
|
DB ' Add "0"-"9" to specify serial port'
|
|
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
|
|
;
|
|
; [WBW] BEGIN: Be more patient waiting for host to start sending file
|
|
LDA FRSTIM ; Get first time flag
|
|
ORA A ; Set CPU flags
|
|
JNZ RCVRPT ; If not first time, bypass
|
|
MVI A,-10 ; Else increase error limit
|
|
STA ERRCT ; Save error new limit
|
|
; [WBW] END
|
|
;
|
|
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
|
|
MVI B,5-1 ; [WBW] 5-second timeout
|
|
CALL RECV ; Get any character received
|
|
JC RCVSTOT ; Timeout
|
|
;
|
|
RCVRPTB:
|
|
IF DEBUG
|
|
CALL ILPRT
|
|
DB CR,LF,0
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
|
|
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
|
|
RCVSER1: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.
|
|
; [WBW] Bypass line flush if error is timeout
|
|
RCVSTOT:
|
|
IF DEBUG
|
|
CALL ILPRT
|
|
DB 'Timeout',CR,LF,0
|
|
ENDIF
|
|
|
|
JMP RCVSER1 ; 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
|
|
IF DEBUG
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
JC RCVSTOT ; Got timeout
|
|
MOV D,A ; D=block number
|
|
MVI B,1 ; Timeout = 1 sec
|
|
CALL RECV ; Get complimented record number
|
|
IF DEBUG
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
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
|
|
IF DEBUG
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
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
|
|
IF DEBUG
|
|
CALL ILPRT
|
|
DB CR,LF,0
|
|
ENDIF
|
|
;
|
|
RCVCRC2:MVI B,1 ; 1 sececond timeout
|
|
CALL RECV ; Get crc byte
|
|
IF DEBUG
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
JC RCVSTOT ; Timeout
|
|
DCR E ; Decrement the number of bytes
|
|
JNZ RCVCRC2 ; Get both bytes
|
|
IF DEBUG
|
|
CALL ILPRT
|
|
DB CR,LF,0
|
|
ENDIF
|
|
CALL CHKCRC ; Check received CRC against calc'd CRC
|
|
ORA A ; Is CRC okay?
|
|
JZ CHKSNUM ; Yes, go check record numbers
|
|
IF DEBUG
|
|
CALL ILPRT
|
|
DB 'CRC Err',CR,LF,0
|
|
ENDIF
|
|
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
|
|
; [WBW] BEGIN: Fixed to put CAN character in A instead of C because
|
|
; SEND uses the A register. Also increased number of CAN characters
|
|
; sent to 3. Credit to HubertH for finding this and providing the fix.
|
|
; MVI C,CAN ; Cancel
|
|
; [WBW] -----
|
|
MVI A,CAN ; Cancel
|
|
CALL SEND ; Sender
|
|
MVI A,CAN ; Cancel
|
|
CALL SEND ; Sender
|
|
MVI A,CAN ; Cancel
|
|
; [WBW] END
|
|
CALL SEND ; Sender
|
|
; [WBW] BEGIN: RCVSABT does not return, so file write error
|
|
; message was never being displayed. Swapped things around
|
|
; to fix this.
|
|
; CALL RCVSABT ; Kill receive file
|
|
; CALL ERXIT ; Exit with msg:
|
|
; DB '++ Error writing file ++$'
|
|
; [WBW] -----
|
|
CALL ILPRT ; Dispaly error msg
|
|
DB CR,LF,'++ Error writing file ++',CR,LF,0
|
|
CALL RCVSABT ; Kill receive file
|
|
; [WBW] END
|
|
|
|
;
|
|
; 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.
|
|
;
|
|
; [WBW] BEGIN: Check immediately for char pending to avoid delay
|
|
CALL RCVRDY ; Input from modem ready
|
|
JZ MCHAR ; Got the character
|
|
; [WBW] END
|
|
;
|
|
; [WBW] BEGIN: Use dynamic CPU speed
|
|
; MVI E,MHZ ; Get the clock speed
|
|
LDA CPUMHZ ; Get the clock speed
|
|
MOV E,A ; Put speed in E
|
|
; [WBW] END
|
|
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
|
|
; [WBW] BEGIN: Use scalar passed in by patch
|
|
;LXI D,6600 ; 1 second DCR count
|
|
XCHG
|
|
LHLD RCVSCL ; Use scalar value from patch
|
|
XCHG
|
|
; [WBW] END
|
|
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'
|
|
; [WBW] BEGIN: Use dynamic CPU speed
|
|
; Loop below is 105TS on Z80 and 96TS on Z180
|
|
; Approx 1024 iter per 100ms per MHz
|
|
; Loop time below extended to accommodate CPU speeds up to 64MHz
|
|
; LXI B,MHZ*4167 ; Value for 100 ms. delay
|
|
; Init BC w/ CPU MHz * 1024
|
|
LDA CPUMHZ ; CPU MHz to A
|
|
RLC ; * 2
|
|
RLC ; * 2, A now has MHz * 4
|
|
MOV B,A ; Use as high byte
|
|
MVI C,0 ; Zero low byte, BC now has MHz * 1024
|
|
; [WBW] END
|
|
DELAY2: DCX B ; Update count
|
|
MOV A,B ; Get MSP byte
|
|
ORA C ; Count = zero?
|
|
JNZ DELAY2 ; If not, continue
|
|
CALL DELAY3 ; WBW: Extend loop time
|
|
CALL DELAY3 ; WBW: Extend loop time
|
|
CALL DELAY3 ; WBW: Extend loop time
|
|
POP B ; Restore 'BC'
|
|
DELAY3: 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
|
|
;
|
|
; [WBW] BEGIN: Use dynamic CPU speed
|
|
;INPUT1: LXI D,1200 ; Outer loop count (about 2 minutes)
|
|
;;
|
|
;INPUT2: LXI B,MHZ*100 ; Roughly 100 ms.
|
|
INPUT1: LXI D,468 ; Outer loop count (about 2 minutes)
|
|
;
|
|
INPUT2: LDA CPUMHZ ; CPU MHz to A
|
|
MOV B,A ; Put in B
|
|
MVI C,0 ; Zero C, BC is now CPU MHz * 256, ~256ms
|
|
; [WBW] END
|
|
;
|
|
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
|
|
;
|
|
IF DEBUG
|
|
;
|
|
; PRINT THE HEX BYTE VALUE IN A
|
|
;
|
|
PRTHEXBYTE:
|
|
PUSH PSW
|
|
PUSH D
|
|
CALL HEXASCII
|
|
MOV A,D
|
|
CALL CTYPE
|
|
MOV A,E
|
|
CALL CTYPE
|
|
POP D
|
|
POP PSW
|
|
RET
|
|
|
|
;
|
|
; CONVERT BINARY VALUE IN A TO ASCII HEX CHARACTERS IN DE
|
|
;
|
|
HEXASCII:
|
|
MOV D,A
|
|
CALL HEXCONV
|
|
MOV E,A
|
|
MOV A,D
|
|
RLC
|
|
RLC
|
|
RLC
|
|
RLC
|
|
CALL HEXCONV
|
|
MOV D,A
|
|
RET
|
|
;
|
|
; CONVERT LOW NIBBLE OF A TO ASCII HEX
|
|
;
|
|
HEXCONV:
|
|
ANI 0FH ;LOW NIBBLE ONLY
|
|
ADI 90H
|
|
DAA
|
|
ACI 40H
|
|
DAA
|
|
RET
|
|
;
|
|
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
|
|
PUSH PSW ; Save accum/flags
|
|
;
|
|
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:
|
|
POP PSW ; Restore accum/flags
|
|
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
|
|
|
|
IF DEBUG
|
|
MOV A,H
|
|
CALL PRTHEXBYTE
|
|
MOV A,L
|
|
CALL PRTHEXBYTE
|
|
ENDIF
|
|
|
|
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
|
|
CPUMHZ: DB MHZ ; [WBW] CPU speed in MHz
|
|
RCVSCL: DW SCL ; [WBW] Recv loop scalar
|
|
PORT: DB 0FFH ; [WBW] Target serial port, FFH=not specified
|
|
;
|
|
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
|
|
STACK EQU 0B000H ; [WBW] Above 8000h for HBIOS Fastpath
|
|
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
|
|
|
|
|