; ; ============================================================================ ; MB-KMD v1.20 - 02/17/87 - REMOTE CP/M FILE TRANSFER PROGRAM ; For use with CP/M 2.2 or CP/M 3.0 ; Adapted by Bob Kramer from KMD and XMODEM ; ============================================================================ ; ; ; ; =============== ; Introduction: ; =============== ; ; MB-KMD is a file transfer program for RCP/M use. It supports both the 1k ; and batch protocols. The biggest difference between MB-KMD and KMD is ; that MB-KMD will fully support standard XMODEM overlays for I/O, however, ; you'll find many new features not implemented in other file xfer programs. ; There is absolutely no sacrifice for those using a BYE program which sets ; up an extended BDOS for I/O, since all that need be done is to set the ; BYEBDOS equate to YES. MB-KMD needs absolutely NO support whatsoever from ; any other program. All that's needed is a CP/M operating system to run on. ; ; ; =================== ; Acknowledgements: ; =================== ; ; MB-KMD is based on previous programs called KMD. The original version of ; KMD was adapted by Irv Hoff from XMODEM. XMODEM was adapted for RCPM use by ; Keith Petersen from MODEM 2.0 by Ward Christensen. Several other programmers ; have contributed through the years prior to the work done in MB-KMD. A few ; of those include Paul Hansknecht who wrote the CRC routines, Sigi Kluger who ; opened the way for the original overlay idea (which MB-KMD doesn't need, but ; fully supports), Paul Traina and Irv Hoff and many other contributors whose ; names we have not been able to verify. Thanks goes out to all who have ; contributed to make these programs what they are today. ; ; ; ==================== ; Using 1k protocol: ; ==================== ; ; The 1k protocol used in MB-KMD is automatically triggered. It is fully ; transparent to modem programs designed to utilize this unique feature. It ; also supports MEX114, YAM and PRO-YAM users who need to manually type 'SK' ; to the sending host unit for 1k transmissions. (YAM users need to be sure ; to use 'RC' at their end to be in CRC mode. Earlier PRO-YAM users may see ; an error at the beginning of an upload to a host unit when using 1k mode ; due to their noise burst detector - this has since been corrected with the ; current PRO-YAM versions). The program also supports the IMP modem program ; in both the manual mode like those previously mentioned as well as the ; MB-KMD automatic mode where no operator intervention is needed. ; ; MB-KMD sends a C and a K to alert modem programs capable of this protocol ; that it can automatically accept their 1k blocks. This has no effect on ; other modem programs as they stop looking when they see the 'C'. This ; automatic feature is thus transparent to all users. This can be easily ; modified to send only one character after the 1k protocol is established ; as the normal operating preference. If no transfer has commenced after ; about 40 seconds "NAK" is sent to inform the host that checksum can be ; accepted. All this is compatible with the original Christensen protocol ; to which CRC was added in 1981. One of the minor changes Ward has made ; since that time was to send the protocol character every two seconds ; instead of every 10 seconds. This initiates the start of the program ; transfer whenever the remote system is ready to send. After considerable ; testing with various modem programs, MB-KMD uses a compromise and sends ; the protocol character each 4 seconds until the upload is commenced. ; ; - Bob Kramer ; Rock Island RCP/M (PBBS) ; 300/1200/2400 ; (309) 786-6227 ; ; =========================== ; Other Contact/Beta Sites: ; =========================== ; ; ; Michael Conley Phil Fleming ; The Charlatan's Cabin Illowa PBBS System ; 300/1200/2400 300/1200 - Callback ; *(213) 656-4192 Nelson Lesmerises (309) 788-3926 ; ECOM ZNODE 74 ; 300/1200 ; (603) 644-5891 ; Arun Baheti ; The CP/M Connection ; 300/1200/2400 ; *(213) 530-0670 ; ; ; A '*' next to phone number indicates number is accessible from PC Pursuit ; ; ; =================================================== ; Conditional equates - change to suit your system, ; then assemble with ASM, LASM, MAC, M80 or SLRMAC ; (Most commonly changed equates noted with an '*') ; =================================================== ; ; ASEG ; Uncomment this line if using M80 to assemble ; NO EQU 0 YES EQU NOT NO ; MHZ EQU 4 ;*Processor speed, use integer (2,4,5,8, etc.) MSPEED EQU 3CH ; Location of BYE's modem speed indicator BYEBDOS EQU YES ;*Set BYEBDOS to YES if you are using BYE5/MBYE44+ ; with it's own I/O routines. No if you are using ; a port/modem I/O overlay out of the MBKMDOVL.LBR. ; LARGEIO EQU NO ; If using an overlay that is larger than 128 bytes, ; you will have to set LARGEIO to YES and equate ; LARSIZE to the actual size of your overlay. LARSIZE EQU 0 ; If 'LARGEIO' is YES, set patch area size (bytes) ; of your overlay here. ; ; ; ======================= ; ZCPR3 Configurations: ; ======================= ; ; If you're using ZCPR, you'll probably want to restrict uploading files with ; a file extent of .NDR, .RCP, or .SYS. If so, set ZCPR to YES and no files ; with those extents will be received unless the WHEEL is on. ; ZCPR EQU YES ;*Set ZCPR to YES if you are running NZCPR/ZCPR/ZCMD. ; When YES, no filetypes .NDR or .RCP are received. ; WHEEL EQU 3EH ; Location of your ZCPR wheel byte (normally 03EH) ; ; ; If you are using ZCPR's DRVMAX and USRMAX memory bytes to restrict downloads, ; set USEMAX to YES. MB-KMD will look at the values in DRIVMAX and USRMAX for ; maximum drive/user. Otherwise, set USEMAX to NO and set MAXDRV and MAXUSR ; to your requirements. ; USEMAX EQU YES ;*Yes, use values at DRIVMAX and USRMAX for maximum DRIVMAX EQU 03DH ; ZCPR maximum drive memory byte USRMAX EQU 03FH ; ZCPR maximum user memory byte MAXDRV EQU 7 ; Maximum 'SEND' drive allowed MAXUSR EQU 5 ; Maximum 'SEND' user allowed ; ; ; The following equates restrict the 'kind' of files a caller will be able to ; download and upload from the system. If ZCPR is YES, these will all be ; available when the WHEEL byte is set. In most cases, you would leave these ; all set to YES for system security. ; NOCOMR EQU YES ; Yes, change .COM to .OBJ and .PRL to .OBP on RECEIVE NOCOMS EQU YES ; Yes, do not send .COM files NOLBS EQU YES ; Yes, do not send .??# files ŠNOSYS EQU YES ; Yes, no $SYS files reported or sent ; ; ; ====================== ; Access Restrictions: ; ====================== ; ; If ACCESS is YES, MB-KMD will inspect AFBYTE (located ACBOFF bytes from ; JMP COLDBOOT) for the following flag data: ; ; ; Bit: 7 6 5 4 3 2 1 0 ; | | | | | | | | ; Privileged user ---* | | | | | | | ; Upload -----* | | | | | | ; Download -------* | | | | | * Of these bits, only 3, 5, 6 and 7 ; CP/M ---------+ | | | | are used by MB-KMD. Bit numbers ; Write -----------* | | | are powers of 2, bit 0 being the ; Read -------------+ | | least significant bit of byte. ; BBS ---------------+ | ; System -----------------+ ; ; ACCESS EQU YES ;*Set to YES if your system sets your BYE program's ; bit-mapped flag register to restrict user's ability ; to upload files, download files, use the 'RM' ; option to upload message files to your BBS's message ; base, or to use the 'RW' option for a 'privileged ; user' upload without being required to give upload ; descriptions. ; ACBOFF EQU 21 ; If you set ACCESS to YES, you 'may' need to set the ; following EQU to reflect the number of bytes from ; JMP COLDBOOT to ACCESS byte. In most cases, leave ; alone. ; ; ; ============================= ; Upload Description Options: ; ============================= ; ; The following equates all have to do with upload descriptions. If you do ; not intend on implementing upload descriptions, set DESCRIB and MSGDESC to ; NO. The rest of these equates are then ignored. ; MSGDESC EQU NO ; Yes, your BBS system supports message uploads, and ; you prefer upload descriptions to be placed in your ; BBS message system (DESCRIB must be NO). MBBS users ; need to install MFMSG.COM with MBBSINIT. Then set ; your BYE program to know about message file uploads ; by setting MSGFIL to YES in BYE/MBYE. If set YES, ; MB-KMD will produce a FOR. text file when writing ; upload descriptions. This FOR. file will go to the ; drive and user area equated at PRDRV and PRUSR just ; before being appended to your BBS system's message ; base. ; DESCRIB EQU YES ;*Set DESCRIB to YES if requiring users to provide ; descriptions for any files they upload. Uploads sent ; to the SYSOP's private upload area will not require ; descriptions, nor will files uploaded with the 'RW' ; option - user must be a privileged user (bit 7 in ; ACCESS byte set) or have WHEEL access and PUPOPT ; must be set YES to use the 'RW' option. ; DRIVE EQU 'A' ;*If using with DESCRIB set YES, you must indicate USER EQU 14 ;*what drive/user you want the 'FOR' file to be ; placed. ; ; ; If DESCRIB above is set to YES, you'll have to tell MB-KMD what information ; you want included in the first line of each description. Code is included ; in MB-KMD to place all (any) information in the upload description header in ; in the same column position no matter what the filename or file category ; length is. The following illustrates a full implementation of DESCRIB. ; ; Example upload description header: ; ; ----- ; PBBS03.LBR - BBS programs (B05:) Rcvd: 12/01/86 ; / / / ; _______/ ______/ _______/ ; ASKIND INCLDU DSTAMP ; ; ASKIND EQU YES ;*Yes, user is asked for the category of the uploaded ; file. This category is then added to the top line of ; the file description. If you set this to YES, make ; sure you set MAXTYP to the highest letter choice you ; wish to support and configure TYPTBL: below to your ; own system needs. (Used only with DESCRIB) ; INCLDU EQU YES ;*Yes, you want the drive/user area to be included in ; the header of the upload description. (Used only ; with DESCRIB) ; DSTAMP EQU YES ;*Yes, enter the date the upload was received on the ; top line of every description. (Used only with ; DESCRIB). ; PUPOPT EQU YES ;*Yes, description request of file upload will be ; skipped when "RW" is used in the MB-KMD command line ; (i.e. KMD RW FILE.EXT). This command may only be ; used by those considered "priviledged" users on your ; system and WHEEL users. Uploads of this type will ; be tagged in the KMD.LOG file as private, so as not ; to display with the NEW command. (See ACCESS equate ; description above). ; WRAPOPT EQU NO ; Yes, give the option of disabling word wrap when ; writing upload descriptions. Allows disabling word ; wrap in order to upload pretyped upload descriptions. ; If NO, there is no option and word wrap will always ; be on. ; WRAP EQU 64 ; Column position where word wrap will occur. If you ; are using MSGDESC and have problems with an 'Invalid ; format' error from MFMSG.COM, try setting WRAP to ; something smaller, like 62 or 63. (72 to disable). ; DESWAIT EQU 2 ; This is the number of minutes of inactivity during ; an upload description or Help Guide prompt before ; logging off the user. ; BSIZE EQU 24*1024 ; This is the size of the description buffer. In most ; cases leave alone. (Set for 24k) ; ; ; ========================= ; Upload Routing Options: ; ========================= ; ; The following equates determine what drive/user area uploads will be sent ; to. If you prefer to enable upload routing (ASKAREA set YES), you will have ; to set MAXTYP to the letter of the highest category you wish to support, and ; configure TYPTBL: and KINDA: tables below for your own system. Do NOT set ; ASKAREA and SETAREA both YES. Doing this will simply disable both features. ; Use one or the other or neither. ; ASKAREA EQU YES ;*Yes, you want upload routing to multiple drive and ; user areas. The caller will be asked what the file ; (or files) he is uploading are for and his uploads ; will then be forwarded to the appropriate area. You ; will need to set up categories at KINDA: for your ; own system and set the drive/user area each category ; belongs on at label TYPTBL:. There can be up to 26 ; different drive/user and category combinations. This ; applies for both private and normal uploads. Upload ; routing is disabled when the WHEEL byte is set, in ; which case, normal uploads will go to the current ; drive/user area and private uploads will go to the ; drive/user equated at PRDRV and PRUSR. ; SETAREA EQU NO ;*Yes, you wish to have all regular uploads forwarded ; to the drive/user equated at DRV and USR to left. If DRV EQU 'B' ; the WHEEL byte is set, regular uploads will go to USR EQU 0 ; the current or specified drive/user. All private ; files uploaded with the 'RP' option will be sent to ; PRDRV and PRUSR regardless of WHEEL byte status. ; PRDRV EQU 'C' ;*This is the drive/user area where ALL files sent to PRUSR EQU 13 ;*the sysop with the 'RP' option will go. This permits ; experimental files, replacement and/or proprietary ; programs to be sent to an area only accessible by ; the sysop. This is also the drive/user area where ; message files are uploaded, if MSGFIL is set YES. ; (If ASKAREA is YES, this is the drive/user where ; uploads will go when 'RP' is specified, and WHEEL ; is set). (If MSGDESC is YES, this is the drive and ; user area the FOR. text file will be placed before ; appending it to the BBS system's message base). ; ; ; =============================== ; Miscellaneous Considerations: ; =============================== ; MSGFIL EQU NO ; Some BBS's allow callers to upload preformatted text ; files which are then appended to the message base. ; (MBBS is an example of this). If you're running MBBS ; and wish to support this, simply set MSGFIL to YES. ; ŠCREDIT EQU YES ;*With CREDIT set to YES, callers are given credit ; for the amount of time they spend uploading ; non-private files. A caller who spends 30 minutes ; sending an upload gets 30 minutes added to his TLOS ; (Time-left-on-system). ; SPLDRV EQU 'B' ;*Drive/user area for downloading private files from SPLUSR EQU 11 ;*the sysop. This permits him to put a special file ; in this area, then leave a private note to that ; person mentioning the name of the file and how to ; download it (KMD SP filename.ext). Although anybody ; 'could' download that program, they don't know what ; (if any) files are there. A high degree of security ; exists, while the SYSOP still has the ability to ; make special files available. Thus any person can be ; a temporary 'privileged user'. ; HIDEIT EQU NO ; Yes, make all new uploads $SYS files. This way, new ; uploads will not appear in a DIRectory listing and ; cannot be viewed or even downloaded until cleared by ; SYSOP. (New uploads will show up when the WHEEL byte ; is ON and a $S option is used to show SYSTEM files). ; Use POWER or NSWEEP to set to $DIR. ; TAGFIL EQU YES ; Yes, don't SEND F2 TAGged .LBR library files, but ; do send individual members, and don't send F2 TAGged ; single files. The TAGFIL and DWNTAG equates help ; you restrict access to .LBR library files and their ; members as well as 'regular' single files you may ; not want to be distributed. In most cases, time- ; left-on-system is sufficient to restrict downloads. ; DWNTAG EQU YES ; With DWNTAG set YES, files with the F3 attribute ; bit set can be downloaded regardless of the user's ; access byte restrictions. This enables you to have ; a closed-system and still allow new callers to have ; access to download an application file, information ; or help files, BBS lists, etc. ; CLRSCRN EQU NO ; Yes, you want MB-KMD to clear your screen locally CLRCH1 EQU 1AH ; during display of batch file transfers and all the CLRCH2 EQU 0 ; help menus. If you set CLRSCRN to YES, enter your CLRCH3 EQU 0 ; clear screen sequence in the 6 bytes aside. (If CLRCH4 EQU 0 ; your terminal uses ^Z, leave as is, 1AH = ^Z). CLRCH5 EQU 0 CLRCH6 EQU 0 ; MINKSPD EQU 1 ; This is the minimum speed acceptable for 1k packet ; file transfers. If you are on a network such as ; PC Pursuit, and you are able to RECEIVE incoming ; calls, set this equate to 1. The delays that these ; networks use to send data back and forth make 1k ; packets advantageous to even 300 bps users. If you ; are not on a network such as PC Pursuit, it's simply ; a matter of preference, however, why not let the 300 ; bps callers experience the 1k packet transfers? ; (1 = 300, 5 = 1200, 6 = 2400, etc.) ; BUFSIZ EQU 16 ; Normal disk systems can transfer 16k from computer ; to disk in 2-3-4 seconds and less. Some very slow ; 5-1/4" floppy systems (such as North Star) may take ; up to 20-30 seconds to transfer 16k. This would ; cause several timeouts at 10 seconds each. If you ; experience any timeouts, try changing BUFSIZ to ; something smaller, perhaps 8k or even 4k. ; USECON EQU YES ; USECON allows MB-KMD to display the record count on ; the local CRT during transfers. Most all new remote ; console programs support this feature. BYE5/MBYE ; will tell MB-KMD where to find the local console's ; output vector. A check to see if BYE is running will ; be made and if not, standard CP/M console output ; vector will be used. (If using with BYEBDOS set NO, ; run CONOUT.COM in the MBKMDOVL.LBR on your system to ; obtain the appropriate address. Enter that address ; at CONOUT equate in your KMxx-n.ASM overlay. Then ; set USECON to NO. Try with USECON set YES first.) ; CONOFF EQU 15 ; Offset to COVECT where the original console output ; routine address is stored in BYE/MBYE immediately ; followed by "BYE" as check to insure BYE is running. ; TIMOUT EQU 5 ; Some modems will either go onhook immediately after ; a carrier loss or can be set to wait a bit. A good ; value with the SmartModem is five seconds, since it ; catches all "call forwarding" breaks. Not all is ; lost after timeout in MB-KMD, BYE will still wait ; some more, but the chance of someone slipping in is ; less now. ; ŠWRTLOC EQU YES ; Set/reset WRTLOC so BYE won't hang up. Check your ; BBS documentation - many modern systems don't need ; WRTLOC. If unsure, set WRTLOC to NO. Code to set and ; reset WRTLOC assumes the WRTLOC byte to be located ; "LOCOFF" bytes from the JMP COLDBOOT instruction at ; the beginning of the BYE BIOS jump table. (YES for ; MBBS and PBBS). ; LOCOFF EQU 12 ; On standard BYE/MBYE versions, offset is usually 12. ; ; ; ================================ ; File Transfer Logging Options: ; ================================ ; LOGCAL EQU YES ;*KMD.LOG is produced if LOGCAL is set YES. All file ; transfers are logged. You can then use NEW.COM or ; similar to show listings of recent uploads. CPM3 EQU NO ; Yes, using CP/M 3.0 and LOGCAL is YES EDATE EQU NO ; Yes, show date in KMD.LOG in dd/mm/yy format instead ; of mm/dd/yy format. ; LOGDRV EQU 'A' ;*Drive to find KMD.LOG on. LOGUSR EQU 14 ;*User area to find KMD.LOG on. LASTDRV EQU 'A' ;*Drive to find LASTCALR??? file on. LASTUSR EQU 14 ;*User area to find LASTCALR??? file on. LCNAME EQU 1 ;*In the LASTCALR??? file, there is sometimes more ; than the last caller's name - date, time, etc. You ; must tell MB-KMD where to find the beginning of the ; caller's name with LCNAME. (MBBS is 12, PBBS is 1). ; LOGLDS EQU YES ;*Count number of up/down loads since login. Your BBS ; program can check UPLDS and DNLDS when a user logs ; out and update either the user's file or a file for ; this purpose. You can either modify your BBS entry ; program to check the LASTCALR file before updating ; and then update (risky), or make a separate program ; that BYE calls when logging off a user (preferred). ; (YES for PBBS). ; UPLDS EQU 054H ; Clear these values to 0 from your BBS program when DNLDS EQU 055H ; somebody logs in. NOTE: Clear ONLY when a user logs ; in, not when he re-enters the BBS program from CP/M. ; ; ; ============================= ; Timekeeping Considerations: ; ============================= ; DTOS EQU NO ; Yes, 'Time on system' message to be displayed at the ; start of program TOSEXIT EQU NO ; Yes, 'Time on system' message is to be displayed on ; exit of program ; MAXTIM EQU YES ;*Yes, you are limiting transmission time. This should ; be set YES, if you want to restrict a caller from ; downloading files according to his Time Left. This ; works with BYEBDOS, B3RTC or TIMEON. ; ; ; ======================== ; BYE3/MBYE Timekeeping: ; ======================== ; ; Do NOT set B3RTC to YES, if BYEBDOS is YES. Many users of the program have ; failed getting MB-KMD up and running because of this one equate. If you are ; running MBYE without extended BDOS, and you have your clock and date reader ; code in MBYE, set B3RTC to YES. Otherwise, leave NO. You might need to set ; B3RTC to YES if you are using an older version of BYE, like BYE3 and earlier. ; B3RTC EQU NO ; If you are NOT using BYEBDOS, but you are using a ; BYE program that maintains it's own clock info, set ; B3RTC to YES. This will enable MB-KMD to display ; "Time on system" and restrict downloads if there is ; not enough time left to complete the download. (This ; should be set YES if running MBYE with it's own RTC ; insert). ; B3COFF EQU 25 ; OFFSET from COLDBOOT: to RTCBUFF address B3CMOS EQU 7 ; OFFSET from RTCBUFF: to mins on system ; MBMXT EQU YES ; Yes, running MBYE with max. time on system MBMXO EQU 24 ; OFFSET from COLDBOOT: to MXML address Š; MTOS EQU YES ; Yes, using maximum time on system instead of MAXMIN ; to limit transmission time. MAXMIN is the default ; if BYE is not running. ; MXTL EQU NO ; Yes, limiting transmission time to time left plus ; MAXMIN. You can have MB-KMD add the value at MAXMIN ; to the caller's Time Left on System and THEN see if ; he has enough time to make the download. (i.e., If ; the caller online has 25 minutes remaining and MXTL ; is set YES, the caller is allowed 25+MAXMIN minutes, ; or 45 minutes, if MAXMIN is 20 as distributed. MTOS ; and MBMXT must also be YES). ; ; ; ========================== ; Alternative Timekeeping: ; ========================== ; ; If your clock reader code is NOT set up in BYE/MBYE, you can still take ; advantage of datestamping, entering dates/times into the log file, and time ; restrictions (on downloads) with the next two equates. MB-KMD can read your ; system clock. This will allow you to display 'Time-on-system' messages and ; restrict a caller's ability to download files by how much time he has left ; online. If you set RTC or TIMEON to YES, make sure that you add your clock ; and/or date reader code at the start of labels GETTIME: and GETDATE: below ; and return the time in registers A & B. (Note: Both of these equates must ; be NO if B3RTC above is set to YES). ; RTC EQU NO ; Yes, code is included at label GETTIME: and GETDATE: ; below to keep track of times and dates for LOGCALL ; routines, datestamping, etc. Also, display "Time on ; system" messages. ; TIMEON EQU NO ; Yes, code is included at label GETTIME: and you want ; MB-KMD to police time on system and restrict callers ; from downloading if there is not enough time left on ; system. MAXMIN will be the default if BYE is not ; running. Return the time in registers A & B. (Set ; to NO if B3RTC is set YES). ; MAXMIN EQU 20 ; Minutes for maximum file transfer time. This should ; be set if TIMEON is YES. (99 max.) (This is ignored ; if BYEBDOS is set) ; 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 ; ORG 100H JMP BEGIN ; ; ; ========================== ; Input/Output Patch Area: ; ========================== ; ; Assemble the appropriate I/O patch file for your modem, then integrate it ; into this program using MLOAD. At first, all jumps are to zero, which will ; cause an unpatched MB-KMD to simply execute a warm boot. All routines must ; end with RET. (See -OVERLAY.LZT in MBKMDOVL.LBR for overlays). ; IF NOT BYEBDOS CONOUT: JMP 0 ; See 'CONOUT.IZF' in MBKMDOVL.LBR MINIT: JMP 0 ; Initialization routine (if needed) UNINIT: JMP 0 ; Undo whatever MINIT did (or return) MDOUTP: JMP 0 ; Send character (via POP PSW) MDCARCK:JMP 0 ; Test for carrier MDINP: JMP 0 ; Receive data byte GETCHR: JMP 0 ; Get character from modem MDINST: JMP 0 ; Check receive ready (A - ERRCDE) MDOUTST: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 overlay ENDIF ; IF LARGEIO AND (NOT BYEBDOS) ORG 100H+LARSIZE ; I/O patch area size over 128 bytes ENDIF ; ; ; ========================================= ; PRIVATE/SETAREA Upload Disk/User Areas: ; ========================================= ; ; Placed here at the start so they can be patched in the .COM file using DDT ; without needing to reassemble. All references are made to these locations ; in memory and not to DRV/PRDRV/USR/PRUSR or WRAP equates directly. ; DB 'Private->' XPRDRV: DB PRDRV ; Drive to receive PRIVATE uploads XPRUSR: DB PRUSR ; User area to receive PRIVATE uploads DB 'Regular->' XDRV: DB DRV ; Drive to receive REGULAR uploads XUSR: DB USR ; User area to receive REGULAR uploads DB 'Wrap->' XWRAP: DB WRAP ; Column where description line wrap occurs ; ; ; =================== ; File Descriptors: ; =================== ; ; The following table defines the text to be included into upload description ; headers (If DESCRIB and ASKIND) and/or defines categories for uploading to ; multiple drive/user areas (If ASKAREA and NOT SETAREA). Change as desired, ; if this list is not suitable. Do NOT remove any of the KIND?: labels from ; the table, as they are pointed to elsewhere in the program. ALSO, do NOT ; skip over any letters when you are assigning entries as this will confuse ; the parsing routines later. When editing for your system, remove the '0' ; after the DB statement for all KIND?: labels up to/and including your MAXTYP ; setting. MAXTYP below must be set to whatever letter your maximum choice ; will be. ; MAXTYP EQU 'I' ; Set this to the letter of the highest category you ; wish to support. ; IF (DESCRIB AND ASKIND) OR (ASKAREA AND (NOT SETAREA)) KINDA: DB ' A) - CP/M Utility ',CR,LF KINDB: DB ' B) - CP/M Application ',CR,LF KINDC: DB ' C) - Game ',CR,LF KINDD: DB ' D) - Word Processing ',CR,LF KINDE: DB ' E) - Language ',CR,LF KINDF: DB ' F) - Spreadsheet ',CR,LF KINDG: DB ' G) - Communications ',CR,LF KINDH: DB ' H) - MS/PC-DOS (All) ',CR,LF KINDI: DB ' I) - Mixed Batch/Misc ',CR,LF KINDJ: DB 0 ;' J) - BBS List ',CR,LF KINDK: DB 0 ;' K) - Lap Computer Program ',CR,LF KINDL: DB 0 ;' L) - RCP/M System Software ',CR,LF KINDM: DB 0 ;' M) - ASCII Transfer Area ',CR,LF KINDN: DB 0 ;' N) - Pascal Utility/Source ',CR,LF KINDO: DB 0 ;' O) - dBase Utility/Source ',CR,LF KINDP: DB 0 ;' P) - BASIC Utility/Source ',CR,LF KINDQ: DB 0 ;' Q) - C Utility/Source ',CR,LF KINDR: DB 0 ;' R) - Printer Utility ',CR,LF KINDS: DB 0 ;' S) - Picture ',CR,LF ŠKINDT: DB 0 ;' T) - ZCPR1/2/3 ',CR,LF KINDU: DB 0 ;' U) - EPSON QX-10 Specific ',CR,LF KINDV: DB 0 ;' V) - KAYPRO Specific ',CR,LF KINDW: DB 0 ;' W) - OSBORNE Specific ',CR,LF KINDX: DB 0 ;' X) - APPLE (CP/M) ',CR,LF KINDY: DB 0 ;' Y) - COMMODORE 128 ',CR,LF KINDZ: DB 0 ;' Z) - ',CR,LF DB 0,'$' ;leave the table terminator alone. ENDIF ; ; ; ======================= ; Upload Routing Table: ; ======================= ; ; If ASKAREA is set YES, then set these areas up to match the message text in ; KIND?: above. Note that the PRIVATE upload may be sent to a different drive ; as well as a different user area, if desired. Each entry is expressed as ; 'drive letter',user area. Simply set MAXTYP above to the highest letter ; choice supported. (Do NOT comment out any of the following storage bytes). ; ; _________ ; NOTE: / A \ <--- 'A' Corresponds to KINDA: above ; 'A',1,'B',15, ; \ / \ / ; Normal upload --+ | ; Private upload -------+ ; ; TYPTBL: IF ASKAREA AND (NOT SETAREA) ; _________ _________ _________ _________ ; / A \ / B \ / C \ / D \ DB 'A',1,'B',15, 'A',2,'B',15, 'A',3,'B',15, 'A',4,'B',15 ; _________ _________ _________ _________ ; / E \ / F \ / G \ / H \ DB 'A',5,'B',15, 'B',0,'B',15, 'B',1,'B',15, 'B',2,'B',15 ; _________ _________ _________ _________ ; / I \ / J \ / K \ / L \ DB 'B',3,'B',15, 'B',4,'B',15, 'B',5,'B',15, 'C',0,'B',15 ; _________ _________ _________ _________ ; / M \ / N \ / O \ / P \ DB 'C',1,'B',15, 'C',2,'B',15, 'C',3,'B',15, 'C',4,'B',15 ; _________ _________ _________ _________ ; / Q \ / R \ / S \ / T \ DB 'C',5,'B',15, 'D',0,'B',15, 'D',1,'B',15, 'D',2,'B',15 ; _________ _________ _________ _________ ; / U \ / V \ / W \ / X \ DB 'D',3,'B',15, 'D',4,'B',15, 'D',5,'B',15, 'E',0,'B',15 ; _________ _________ ; / Y \ / Z \ DB 'E',1,'B',15, 'E',2,'B',15 ENDIF ; ; ; ============================================================== ; Do not change the next 5 equates. They're set automatically ; according to how you've set the equates above. ; ============================================================== ; IF RTC OR B3RTC OR BYEBDOS ŠCLOCK EQU YES ; (leave YES) ENDIF ; IF NOT (RTC OR B3RTC OR BYEBDOS) CLOCK EQU NO ; (leave NO) ENDIF ; IF BYEBDOS AND B3RTC ERROR!!! YOU CAN NOT SET BYEBDOS AND B3RTC BOTH YES ENDIF ; IF DESCRIB AND MSGDESC ERROR!!! YOU CAN NOT SET DESCRIB AND MSGDESC BOTH YES ENDIF ; IF ASKAREA AND SETAREA ERROR!!! YOU CAN NOT SET SETAREA AND ASKAREA BOTH YES ENDIF ; ; ; ===================== ; Program Starts Here ; ===================== ; ; Save CP/M stack, initialize new one for this program ; BEGIN: LXI H,0 DAD SP SHLD STACK ; Save current return to CCP address LXI SP,STACK ; Reset the stack ; IF BYEBDOS CALL BYECHK ; Is BYE running JZ BYEOK ; We're ok CALL ILPRTB DB CR,LF DB 'BYEBDOS not available...aborting...',CR,LF,BELL,0 JMP 0 ; BYEOK: MVI C,81 ; Get current maximum time on system MVI E,255 CALL BDOS STA MAXTOS ; Store it MVI E,0 MVI C,81 ; Stop BYEBDOS from checking time just now CALL BDOS MVI C,79 ; Ask for TON and RTC address CALL BDOS STA TON ; Save time on system PUSH B MOV B,A ; Save it LDA MAXTOS ; Get MXTIME¦FCONT3 SUB B ; MXTIME-TON=TLOS (Time left on system) STA TLOS ; And store it POP B ENDIF ; IF B3RTC AND MTOS AND MBMXT 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 maximum time allowed on system ENDIF ; IF RTC AND MAXTIM CALL WHLCHK ; Will be Zero if ZCPR is NO, or WHEEL is off JNZ NOLIMIT ; If WHEEL set, leave MAXTOS at zero MVI A,MAXMIN ; Stuff MAXTOS if using RTC STA MAXTOS NOLIMIT: ENDIF ; ; Get address of RTCBUF in BYE5 or MBYE ; IF B3RTC AND (NOT BYEBDOS) CALL BYECHK JNZ NOBYE LHLD 0001H ; Get COLDBOOT address 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 ; NOBYE: 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 SHLD CKABORT+1 ; Stuff after call for CKABORT INX H ; INX H INX H ; + 3 = address of console input SHLD CKABRT+1 ; Stuff after call for CKABRT ; ; 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 ; BYE is running, just need vector JNZ NOBYE1 XCHG ; Point to the console output routine SHLD CONOUT+1 ; Save vector address supplied by BYE NOBYE1: ENDIF ; CALL SETLCK ; Set WRTLOC if needed ; IF ACCESS AND BYEBDOS MVI C,85 ; Access flags byte MVI E,255 CALL BDOS ; Byte returned in 'A' STA AFBYTE ; Store it ENDIF ; IF ACCESS AND (NOT BYEBDOS) PUSH H 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 POP H STA AFBYTE ; Store it ENDIF ; MVI E,0FFH MVI C,SETUSR ; Get the current user area CALL BDOS STA OLDUSR ; Save it for now MVI C,CURDRV ; Get the current drive CALL BDOS STA OLDDRV ; Save it for now ; CALL CLEARIT ; Clear local screen if CLRSCRN is YES CALL ILPRTB ; Reset mode to display to both consoles DB 0 ; IF RTC OR DTOS CALL TIME ; Get user's time status, or display 'Time on' ENDIF ; ; Now, tell 'em who we are ; CALL ILPRTB DB CR,LF DB 'MB-KMD v' DB VERS+'0','.',MODLEV+'0',REV+'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',0 ; CALL WHLCHK ; If ZCPR, is WHEEL on? JZ NOWHL ; No, then don't say anything CALL ILPRTL ; Else, print it to local console only DB ' (WHEEL)',0 ; NOWHL: CALL ILPRTB ; Finish sign on DB CR,LF,0 CALL CATCH ; Gobble up garbage characters from line ; ; Check option for send or receive ; LXI H,FCB+1 MOV A,M ; Get the main option STA OPTSAV ; Save it for later use STA CRCFLG ; Insure in CRC mode now ; IF LOGCAL STA LOGOPT ; Save for the station's log file ENDIF ; CPI 'F' ; Checking FREE space? JZ SPACE CPI 'A' ; To send a file from a .ARC/.ARK library? JZ SETLAM CPI 'L' ; To send from a .LBR library? JZ SETLAM CPI 'S' ; To send a normal file? JZ CHKSND CPI 'R' ; Going to receive a file? JNZ OPTERR ; None of these, show help guide ; LDA MSPEED ; Get current baud rate CPI MINKSPD ; Lowest baud rate allowed for 1k JC CKROPT ; If less than MINKSPD, skip 1k blocks STA KFLG ; Otherwise, set the 1k flag for now ; ; Check for additional receive options ; CKROPT: INX H MOV A,M ; Get the receive option, if any CPI 'P' ; Requesting Private upload? JZ SETPRV ; IF ACCESS AND PUPOPT CPI 'W' ; Special privileged transfer request? JNZ CKROP1 ; No, continue MVI A,1 STA PUPFLG ; Show privileged transfer requested JMP CKROP2 ; Check for more options ENDIF ; CKROP1: IF MSGFIL CPI 'M' ; Message file? ENDIF ; JNZ CKROP2 ; None of these ; IF MSGFIL STA MSGFLG ; Else set the message flag MVI A,'P' ; ...and... ENDIF ; SETPRV: STA PRVTFL ; Set the private flag ; CKROP2: INX H MOV A,M ; Get next receive option CPI ' ' ; Is it a space or a character? JZ RCKBCH ; If yes, see if requesting Batch CPI 'B' ; Batch mode? JZ RCKBCH CPI 'C' ; Forcing Checksum? JZ RCKSM CPI 'X' ; Forcing Xmodem 128 byte blocks? JNZ R1024 ; No, see if wanting 1024 byte blocks ; ; Have asked for a private upload so check for "B", "C" or "X" request ; R128: XRA A ; Reset the 1k block flag STA KFLG JMP RCRC ; R1024: LDA MSPEED ; Get caller's current speed CPI MINKSPD ; Less than minimum speed for 1k JC R128 ; Skip 1k MOV A,M ; Get option back CPI 'K' ; Want YMODEM? JNZ OPTERR ; Not valid, jump to Runtime Help Guide CALL YMSG ; Show protocol JMP RCVFL ; SETLAM: STA LBRARC ; Set .LBR/.ARK/.ARC extraction flag ; CHKSND: INX H ; Next space on command line MOV A,M ; Get the character CPI ' ' ; Any more options? JZ SNDFL ; No, finished checking CPI 'X' ; Wants XMDM protocol? JNZ CHKSND1 ; No, continue checking CALL XMSG ; Else, show protocol JMP SNDFL ; Send the file ; CHKSND1:CPI 'K' ; Forcing 1k protocol? JNZ CHKSND2 ; No, continue checking LDA MSPEED ; Get caller's current speed CPI MINKSPD ; Is it lower than allowed for 1k packets? JC SNDFL ; Yes, don't allow 1k packets STA KFLG ; No, set 1k flag for now CALL YMSG ; Show protocol JMP SNDFL ; CHKSND2:LDA LBRARC ORA A ; Library member extraction? JNZ SNDFL ; Yes, ignore Batch MOV A,M ; Get character CPI 'B' ; Requesting Batch? JNZ CHKSND3 ; No, continue checking STA YMODEM ; Prepare for Ymodem Batch send JMP SBCH ; Go send Batch ; CHKSND3:CPI 'P' ; Requesting Private? JNZ CHKSND ; No, check for more options STA SPLFL ; Set the private download flag JMP CHKSND ; Loop for more options ; ; Allows batch mode to private area if R, RB or RPB is typed ; RCKBCH: LDA FCB1+1 ; Was a file was requested CPI ' ' JNZ RCRC ; Can't use batch if file requested INR A ; Set BATCH mode flag STA BCHFLG CALL BCHMSG ; Show batch enabled message JMP RCVFL ; RCRC: MVI A,1 STA CRCFLG ; Show in CRC mode CALL XMSG ; Show protocol JMP RCVFL ; RCKSM: XRA A STA CRCFLG STA KFLG ; Can't use 1k blocks with checksum CALL ILPRTB DB CR,LF DB '(Xmodem Checksum / 128-byte packets)',CR,LF,0 JMP RCVFL ; SBCH: LDA SPLFL ; Sending from the private area? ORA A JNZ SNDFL ; If yes, skip batch message INR A ; To set the batch flag to non-zero CALL BCHMSG ; Show batch enabled message JMP SNDFL ; BCHMSG: STA BCHFLG ; Set the batch flag LDA MSPEED ; Check speed being used CPI MINKSPD ; Is it lower than minimum JC XMSG ; 1k packets not used below MINKSPD CALL ILPRTB DB CR,LF DB '(Ymodem Batch CRC / 1k packets)',CR,LF,0 RET ; XMSG: CALL ILPRTB DB CR,LF DB '(Xmodem CRC / 128-byte packets)',CR,LF,0 RET ; YMSG: CALL ILPRTB DB CR,LF DB '(Ymodem CRC / 1k packets)',CR,LF,0 RET ; ; ; ============================== ; Show available upload space: ; ============================== ; SPACE: CALL RSTLCK ; Go reset WRTLOC if needed ; IF SETAREA OR ASKAREA CALL WHLCHK ; Is WHEEL byte set? JNZ SPACE1 ; Yes, tell him he can upload anywhere LDA OPTSAV ; No, are we here from CP/M, or Help Guide? CPI 'F' JZ SPACE0 ; From CP/M, only 1 line feed CALL ILPRTB DB CR,LF,LF,0 ENDIF ; SPACE0: IF SETAREA AND (NOT ASKAREA) CALL ILPRTB DB CR,LF,0 ENDIF ; CALL FILTYP ; Get upload area if ASKAREA ; IF SETAREA OR ASKAREA JMP SPACE2 ENDIF ; SPACE1: CALL ILPRTB ; Either the WHEEL is on, or SETAREA is NO DB CR,LF DB 'Uploads go to specified or current disk/user',CR,LF,LF,0 LDA OLDDRV ; Get currently logged drive ADI 'A' ; Make it ASCII STA XDRV ; Store it for KSHOW LDA OLDUSR ; Get currently logged user STA XUSR ; Store it for KSHOW ; SPACE2: CALL ILPRTB DB CR,0 ; IF ASKAREA AND (NOT SETAREA) CALL WHLCHK JZ SPC2A ENDIF ; CALL ILPRTB DB ' Normal Uploads to > ',0 JMP SPC2B ; SPC2A: IF ASKAREA AND (NOT SETAREA) CALL ILPRTB DB CR DB ' Normal ',0 XRA A STA NODASH INR A STA FRMSPC ; Show where we're coming from LDA SAVTYP STA KIND CALL AFIND1 ; Display selected upload area's category CALL ILPRTB DB ' file(s) to > ',0 ENDIF ; SPC2B: LDA XDRV CALL CTYPE LDA XUSR MVI H,0 MOV L,A CALL DECOUT MVI A,':' CALL CTYPE CALL ILPRTB DB ' (',0 LDA XDRV STA KDRV CALL KSHOW MVI A,')' CALL CTYPE ; CALL ILPRTB DB CR,LF,0 ; IF ASKAREA AND (NOT SETAREA) CALL WHLCHK JZ SPC2C ENDIF ; CALL ILPRTB DB ' Private Uploads to > ',0 JMP SPC2D ; SPC2C: IF ASKAREA AND (NOT SETAREA) CALL ILPRTB DB ' Private ',0 XRA A STA NODASH INR A STA FRMSPC ; Show where we're coming from CALL AFIND1 ; Display selected upload area's category CALL ILPRTB DB ' file(s) to > ',0 ENDIF ; SPC2D: LDA XPRDRV CALL CTYPE LDA XPRUSR MVI H,0 MOV L,A CALL DECOUT MVI A,':' CALL CTYPE ; LDA XDRV PUSH H LXI H,XPRDRV CMP M ; Private same as regular drive? POP H JZ SPACE3 ; Yes, don't report 'k' this time ; CALL ILPRT ; Report available 'k' for private DB ' (',0 LDA XPRDRV STA KDRV CALL KSHOW MVI A,')' CALL CTYPE ; SPACE3: CALL ILPRTB DB CR,LF,0 LDA OPTSAV ; Check to see if here from CP/M, 'KMD A' CPI 'F' JZ EXIT ; Yep, we're done, skip next and exit to CP/M ; ; We must be here from the Help Guide. To keep the screen consistant in the ; Help Guide, we need to know how we just displayed the above. ; IF ASKAREA AND (NOT SETAREA) CALL WHLCHK ; WHEEL byte set? JZ OPTERR2 ; Yes, give 4 line feeds ENDIF ; JMP OPTERR1 ; ; ; ===================== ; Runtime Help Guide: ; ===================== ; ; Either KMD was entered by itself from CP/M, or an invalid option was given. ; OPTERR: CALL ILPRTB DB CR,LF DB 'Runtime Help Guide',0 JMP OPTERR2 ; Skip line feeds ; OPTERR1:CALL ILPRTB ; Print 2 line feeds to screen DB CR,LF,LF,0 ; OPTERR2:CALL RSTLCK CALL ILPRTB DB CR,LF,LF DB ' eceive files from you to this BBS',CR,LF DB ' end files from this BBS to you',CR,LF DB ' RK/ARC/LBR member downloads',CR,LF DB ' ree upload space',CR,LF DB ' ther information',CR,LF DB ' xit to CP/M',CR,LF,LF DB 'Select the HELP you need: ',0 ; ; ; Get user's input and see if it is a valid choice. Exit him to CP/M if no ; input is received within DESWAIT minutes. ; GETHLP: CALL CATCH CALL INPUT ; Check keyboard status and get input CALL UCASE ; Change to uppercase CPI 'R' ; 'R' ? JZ HLPRCV ; Yes, help him UPLOAD CPI 'S' ; 'S' ? JZ HLPSND ; Yes, help him DOWNLOAD CPI 'A' ; 'A' ? JZ HLPLBR ; Yes, him him get ARK/ARC/LBR members CPI 'F' ; 'A' ? JZ HLPSPC ; Yes, just show him available 'k' CPI 'O' ; 'O' ? JZ HLPINF ; Yes, tell him about us CPI 'E' ; 'E' ? JNZ GETHLP ; None of these, let's ask him again CALL CATCH ; Eat garbage before exiting CALL ERXIT1 ; Yes, He doesn't need any help DB 'E$' ; ; ; Upload help... ; HLPRCV: CALL HLPHDR ; Print option and 5 line feeds to screen CALL ILPRTB DB 'UPLOADS (from you to this system)',CR,LF,LF DB ' KMD R example.obj Normal file upload',CR,LF DB ' KMD RC example.lbr Force Checksum',CR,LF DB ' KMD RP example.aqm Private upload',CR,LF DB ' KMD RPC example.dqc Private upload - Checksum',CR,LF DB ' KMD R 1k BATCH (YMODEM-type)',CR,LF ; IF MSGFIL DB ' KMD RM example.msg Pre-formatted message file ' DB 'upload',CR,LF ENDIF ; DB 0 ; Either way, we stop here until we know next ; IF PUPOPT LDA AFBYTE ; Get access flags byte, all zero if ACCESS no ANI 80H ; Check to see if user is privileged JNZ HLPRCV0 ; Yes, show him 'RW' option CALL WHLCHK ; No, is sysop or WHEEL user online? JZ HLPRCV1 ; No, we're done, loop back to menu ; HLPRCV0:CALL ILPRTB DB ' KMD RW example.fil Receive without description(s)' DB 0 ENDIF ; HLPRCV1:CALL ILPRTB DB CR,LF,LF,0 JMP OPTERR1 ; Get next option from Help Guide Menu ; ; ; Download help... ; HLPSND: CALL HLPHDR ; Print option and 4 line feeds to screen CALL ILPRTB DB 'DOWNLOADS (from this system to you)',CR,LF,LF DB ' KMD S example.lbr Normal file download',CR,LF DB ' KMD S B1:example.dqc From a named D/U area',CR,LF DB ' KMD SK example.lbr Force 1k protocol',CR,LF DB ' KMD SC example.lbr Force Checksum',CR,LF DB ' KMD SX example.tqt Force 128 byte protocol',CR,LF DB ' KMD SB example.* 1k BATCH (YMODEM-type)',CR,LF,LF DB ' (Use the option for help with downloading ARK/ARC/LBR' DB ' members)',0 JMP OPTERR1 ; Get next option from Help Guide Menu ; ; ; ARK/ARC/LBR file extraction help... ; HLPLBR: CALL HLPHDR ; Print option and 5 line feeds to screen CALL ILPRTB DB 'ARK/ARC/LBR Member Downloads',CR,LF,LF DB ' KMD L libnm example.dqc Download .LBR member',CR,LF DB ' KMD LC libnm example.dqc Force Checksum',CR,LF DB ' KMD LX libnm example.aqm Force 128 byte protocol',CR,LF,LF DB ' KMD A arcnm example.exe Download .ARK/.ARC member',CR,LF DB ' KMD AK arknm example.com Force 1k protocol' DB CR,LF,LF,0 JMP OPTERR1 ; Get next option from Help Guide Menu ; ; ; Free upload space... ; HLPSPC: CALL HLPHDR ; Print option and 4 line feeds to screen CALL ILPRTB DB CR,LF DB 'To show available space for UPLOADS, enter:',CR,LF,LF DB ' KMD F',CR,LF,0 JMP SPACE ; Go show actual upload space ; ; ; Other information... ; HLPINF: CALL HLPHDR ; Print option and 4 line feeds to screen CALL ILPRTB DB 'OTHER information - Compatibility',CR,LF,LF DB ' 1) MB-KMD provides 100% support for XMDM protocols.',CR,LF DB ' 2) MB-KMD uses automatic protocol detection and will',CR,LF DB ' determine which mode to use for a transfer:',CR,LF DB ' 128 byte records (CRC or Checksum) or 1k records',CR,LF DB ' with IMP, MEX114+, Yam, ProYam, or Procomm v22+.',CR,LF DB ' 3) 1k BATCH transfers are supported when using',CR,LF DB ' IMP, Yam, ProYam, or Procomm v22+ (MS-DOS).',CR,LF,0 JMP OPTERR1 ; Get next option from Help Guide Menu ; ; ; Print valid option to screen, scroll a few lines on user's terminal. ; HLPHDR: CALL CTYPE ; Display character in 'A' CALL CLEARIT CALL ILPRTB DB CR,LF,LF,0 CALL CLEARIT ; Clear local screen, if supposed to. ; HLPHDR1:CALL ILPRTB DB CR,LF,LF,LF,0 RET ; ; ; =========================== ; ----> SNDFL - Send a file: ; =========================== ; ; The file specified in the MB-KMD command line is transferred over the ; phone to another computer with modem using the "S" (send) option. The ; data is sent one record at a time with headers and checksums, and ; retransmission on errors. ; SNDFL: IF ACCESS CALL WHLCHK ; Is WHEEL byte set? JNZ SNDFL0 ; Yes, skip access check LDA AFBYTE ; No, get the access flags byte ANI 20H ; Does he have Download access? JZ NOACC ; No, tell him and exit ENDIF ; SNDFL0: XRA A ; Clear flags STA SNDFLG ; Show in send mode LDA BCHFLG ; Batch mode requested? ORA A JNZ SBTCH ; If yes, go handle batch mode CALL LOGDU ; SNDFL1: LDA LBRARC ORA A ; If library option skip 'CNREC' CZ CNREC ; Ignore if in library mode ; SNDFL2: CALL OPNFIL ; Open the file CALL RDBLK1 ; Put up to 16k from file into buffer CALL CATCH ; Clear the decks MVI E,60 ; Wait up to 1 minute for initial 'NAK' CALL WAITNAK CALL SETFLG ; Can't use 1k if not 8 records in file ; ; Loops back to this point after a successful transmission for next one ; SNDLP: CALL GTRATIO ; Check the ACK ratio if using 1k blocks CALL RDRECD ; Read a record JC SNDEOF ; Send 'EOF' if done CALL INCRNO ; Bump record number if sent ok CALL SNDABT ; Local abort? XRA A ; Initialize error count to zero STA ERRCT ; ; Comes back here to repeat previous transmission if no ACK was received ; SNDRPT: CALL CKABORT ; Check for remote abort CALL FUNCHK ; Check the function keys CALL SNDABT ; Check for local abort CALL SNDHDR ; Send a header CALL SNDREC ; Send data record CALL SNDCHK ; Send CRC or checksum value CALL GTACK ; Get the 'ACK' JC SNDRPT ; No 'ACK', repeat transmission CALL SETPTR ; Successful record so increase pointers LDA LBRARC ; Get the command option again ORA A JZ SNDLP ; If not library option, exit ; SNDRP1: CALL SETLBR ; Set library pointers and size left LHLD RCNT ; See if anything was actually sent MOV A,H ORA L ; See if L and H both zero now JNZ SNDLP ; If finished, exit ; ; File sent, send EOT but do local log-keeping first ; SNDEOF: IF LOGLDS LDA DNLDS ; Get Down loads Counter INR A ; One more download since log in STA DNLDS ; And update counter ENDIF ; IF LOGCAL CALL LOGCALL ; Write log entries first ENDIF ; EOF1: CALL EOFSND CALL ALLDON JMP DONE ; ; Sends batch mode ; SBTCH: LDA FSTFLG ; If first time through ORA A JNZ SBTCH1 ; If not first time, exit CALL ILPRTB DB CR,LF DB 'Locating selection(s)...',0 CALL LOGDU ; Check disk, user CALL TNMBUF ; Put all requested files into NAMBUF ; ; Total number of files, total records and total length is shown, user ; then gets up to 5 seconds to abort. ; CALL ILPRTB DB CR DB 'Number of files found > ',0 LDA FILCNT ; Get total files STA SHOCNT PUSH PSW MOV L,A MVI H,0 CALL DECOUT ; Show remote # of files POP PSW ORA A ; Abort if no files to send JZ NOFILE CALL ILPRTB DB CR,LF DB 'Xmodem 128-byte packets > ',0 LHLD TOTREC ; Get total records - all files PUSH H CALL DECOUT ; Show remote CALL ILPRTB DB CR,LF DB 'Ymodem 1k packets > ',0 POP H CALL DIVREC ; Divide number of records by 8 CALL DECOUT ; Show # of k CALL ILPRTB DB CR,LF DB 'Disk space you need > ',0 LHLD BLOKK ; Get k required on remote disk for 2k XCHG ; Block size LHLD BLOKK DAD D ; Double the size for 2k blocks CALL DECOUT ; Print it CALL ILPRTB DB 'k (2k blocks)',0 ; SBTCH1: LDA FILCNT ORA A JZ SBTCH2 LDA FSTFLG STA CONONL ORA A ; Past first batch file? JZ SHOREM ; No, else show local ; CALL CLEARIT CALL ILPRTL DB CR,LF DB 'Remaining transfer time > ',0 LDA MSPEED ; Get speed indicator CPI 1 ; Are we at 300 bps? JZ SKPREM1 ; Yes, show 128-byte transfer time JMP SKPREM ; No, show 1k transfer time ; SHOREM: CALL ILPRT DB CR,LF,LF DB 'Total transfer time > ',0 LDA MSPEED ; Get speed indicator CPI 1 ; Are we at 300 bps? JZ SKPREM1 ; Yes, skip next line, show 128-byte time ; SKPREM: LXI H,KTABLE ; This gives us 1k transfer time JMP $+3 ; Skip 128-byte time, we have a difference ; SKPREM1:LXI H,XTABLE ; This gives us 128-byte transfer time LDA MSPEED ; Get speed indicator MVI D,0 MOV E,A ; Set up for table access DAD D ; Index to proper factor DAD D MOV E,M INX H MOV D,M LHLD TOTREC ; Get number of records CALL FILTIM1 CALL OPNOK4 CALL ILPRT DB CR,LF,0 LDA FSTFLG ORA A ; Past first batch file? JZ NOXTRA ; No, else give extra CR,LF CALL ILPRT DB CR,LF,0 CALL CATCH ; Get stray garbage ; NOXTRA: LDA FSTFLG ORA A JNZ SBTCH2 INR A ; Now show we have been this way STA FSTFLG CALL ILPRTB DB CR,LF DB 'Your selection(s) ready to Download',CR,LF DB ' Abort: CTRL-X [pause] CTRL-X',CR,LF,0 CALL ILPRTL ; Show locally only DB LF DB ' [ waiting ]',CR,0 ; SBTCH2: CALL CKABORT CALL FUNCHK ; Check for function keys CALL SNDABT ; Check for local abort CALL SNDFN ; Sends file name to receive JC SBTCH4 ; No more files, exit CALL SHOWFIL ; Show the batch filename JMP SNDFL1 ; Send the file ; SBTCH4: LDA GOTONE ; Did we actually send at least one? ORA A JZ ABORT ; If not, don't act like we did CALL EOFSND ; No more files so send EOT to finish CALL XFRDON CALL WAIT1 JMP EXIT ; NOFILE: CALL ERXIT DB CR DB '++ No matching filename(s) found ++','$' ; EOFSND: MVI A,EOT ; Send an 'EOT' CALL SEND LDA CHKEOT ; Did not get an ACK, try again INR A STA CHKEOT ; Limit number of retries to 4 CPI 4 ; (to prevent possible 'lock-up') RNC ; Quit if already sent 4 or more CALL GTACK ; Get the ACK JC EOFSND ; Resend if carry is set RET ; ALLDON: LDA BCHFLG ; In batch mode? ORA A RNZ ; If yes, ignore message CALL ILPRT ; (Want to keep this a separate message) DB CR,LF,0 ; XFRDON: CALL ILPRT DB CR,LF DB ' [ Transfer completed ]',CR,LF,0 CALL DELAY CALL CLEARIT ; Clear screen if we're supposed to RET ; SNDABT: LDA SYSABT ORA A ; Local abort? JNZ ABORT ; Yes, else return RET ; ; ; ============================== ; ----> RCVFL - Receive a file: ; ============================== ; ; The filename specified in MB-KMD command line is transferred over the phone ; from the user's computer to the RCPM system via modem using the R (receive) ; option. The data is sent one record at a time, with headers and checksums ; and retransmissions on errors. ; RCVFL: IF MSGFIL LDA MSGFLG ORA A ; Message file upload? JZ RCVOK1 ; No, skip the rest CALL WHLCHK JZ RCVOK ; No, so skip next XRA A STA WHEEL ; Turn off WHEEL CALL ILPRTB DB 'Receiving preformatted MESSAGE upload',CR,LF,0 JMP RCVOK4 ENDIF ; IF MSGFIL AND ACCESS RCVOK: LDA AFBYTE ANI 8 ; Test write access bye JZ NOACC ; No, so tell him and exit JMP RCVOK4 ; Yes, so proceed with Upload ENDIF ; RCVOK1: IF ACCESS CALL WHLCHK JNZ RCVOK3 ; Yep, skip all this checking ENDIF ; IF ACCESS AND PUPOPT LDA PUPFLG ORA A ; Privileged transfer option request? JZ RCVOK2 ; No LDA AFBYTE ANI 80H ; Test for privileged user access (bit 7) JZ NOACC ENDIF ; RCVOK2: IF ACCESS LDA AFBYTE ANI 40H ; Test bit 6 for upload access JZ NOACC ; Tell him he don't have this access ENDIF ; RCVOK3: LDA BCHFLG ; Requesting batch mode? ORA A JNZ RCVBCH ; If yes, exit ; RCVOK4: CALL RCVFL1 ; Find drive/user/filetype permitted CALL RCVFL6 ; Display drive/user area CALL CONTIN ; Display drive/user area CALL MAKEFIL ; Open the file, ready to receive ; RCVLP: CALL RCVRECD ; Get a record JC RCVEOT ; Exit if 'EOT' for end of current file CALL INCRNO ; Bump record number, if received ok CALL WRRECD ; Write the record CALL SNDACK ; Ack the record JMP RCVLP ; Loop until 'EOF' ; ; ------------- ; ; Using batch so reset flags ; RCVBCH: XRA A STA FRSTIM ; Needs to be reset for each new file MVI A,1 STA SNDFLG ; Shows we are in receive batch mode LDA FSTFLG ; First batch file? ORA A JNZ RCVBC1 ; If not, exit INR A STA FSTFLG ; No need to run those routines again CALL RCVFL1 ; Find drive/user/filetype permitted CALL CONTIN ; Display drive/user area LXI H,NAMBUF SHLD NBSAVE ; RCVBC1: CALL RCVFN ; Get the batch file name and display JC RCVBC2 ; If all done, exit CALL RCVFL6 ; Change file extent if needed CALL CHEKFIL ; Already have a file with that name? CALL MAKEFIL CALL BCHINR CALL ILPRTL DB CR,LF DB ' [ waiting ]',CR,0 CALL WAIT1 ; Let line settle CALL WAIT1 MVI A,CRC CALL SEND MVI A,KSND ; Request 1k blocks CALL SEND JMP RCVLP ; Start receiving the file ; RCVBC2: XRA A ; Zero the batch mode flag STA BCHFLG LDA GOTONE ; Were there any files received? ORA A JZ ABORT ; No, abort CALL XFRDON ; Show transmission is finished CALL WAIT1 ; Delay to let remote get into ter. mode JMP CRED ; (Ask for descriptions) ; ; ; ============== ; ; Check on what drive/user area the file(s) will go into ; RCVFL1: CALL LOGDU ; Select drive/user for upload ; IF ACCESS AND PUPOPT LDA PUPFLG ; Place "RW" file as needed ORA A ; Can only be set if user is privileged JNZ RCVFLA ; Privileged, else check if sysop... ENDIF ; IF ZCPR CALL WHLCHK ; Let WHEEL user put file wherever he wants JZ RCVFL5 ; If WHEEL byte not set, stay normal ENDIF ; RCVFLA: IF ZCPR LDA RCVDRV ORA A JZ RCVFL2 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 RET ENDIF ; ZCPR ; RCVFL5: IF SETAREA OR ASKAREA LDA XDRV SUI 40H STA FCB ENDIF ; LDA PRVTFL ; Receiving to a private area? ORA A RZ ; If not, exit LDA XPRDRV ; Private area takes precedence SUI 40H ; Convert to binary STA FCB ; Store drive to be used RET ; ; Changes the name of certain type of files such a .COM to .OBJ, ect. ; RCVFL6: CALL WHLCHK ; Wheel byte set for SYSOP? RNZ ; Yes, don't change any file extents ; 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 'Renaming file to ".OBJ"',CR,LF,0 LXI H,FCB+9 MVI M,'O' INX H MVI M,'B' INX H MVI M,'J' RET ; RCVFL7: 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 INX H ; Get 3rd letter MVI A,'L' ; 3rd letter CMP M ; Is it 'L' ? JNZ RCVFL8 CALL ILPRT ; Print renaming message DB 'Renaming file to ".OBP"',CR,LF,0 LXI H,FCB+9 MVI M,'O' INX H MVI M,'B' INX H MVI M,'P' RET ENDIF ; NOCMR ; RCVFL8: IF ZCPR 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' ? JZ RCVFL11 ; If yes, print error message and abort ; RCVFL9: LXI H,FCB+9 ; Point to filetype MVI A,'R' ; 1st letter CMP M ; Is it R ? JNZ RCVFL10 ; If not, continue normally INX H ; Get 2nd letter MVI A,'C' ; 2nd letter CMP M ; Is it C ? JNZ RCVFL10 ; If not, continue normally INX H ; Get 3rd letter MVI A,'P' ; 3rd letter CMP M ; Is it P ? JZ RCVFL11 ; Else play error message ; RCVFL10:LXI H,FCB+9 ; Point to filetype MVI A,'S' ; 1st letter CMP M ; Is it S ? RNZ ; If not, continue normally INX H ; Get 2nd letter MVI A,'Y' ; 2nd letter CMP M ; Is it Y ? RNZ ; If not, continue normally INX H ; Get 3rd letter MVI A,'S' ; 3rd letter CMP M ; Is it S ? JZ RCVFL11 ; Else play error message RET ; If not, continue normally ; RCVFL11:CALL ERXIT ; Print renaming message DB '++ Select a different file extent ++','$' ENDIF ; RET ; Just in case ZCPR not used, etc. ; ; Displays where the file(s) will go, opens the file and shows the name ; CONTIN: IF ASKAREA AND (NOT SETAREA) CALL WHLCHK ; WHEEL byte set? JNZ CONT ; Yes, let this guy put file where he wants CALL FILTYP ; No, show the file categories and get choice JMP CONT0 ENDIF ; CONT: CALL ILPRT ; Print the message DB CR,LF,0 ; CONT0: CALL ILPRTB DB CR DB 'Uploads received on > ',0 LDA PRVTFL ; Going to store in the private area? ORA A JZ CONT1 ; If not, exit LDA XPRDRV ; Get private drive SUI 40H ; Convert ASCII to binary STA FCB LDA XPRDRV JNZ CONT2 ; If yes, it takes priority ; CONT1: IF ACCESS AND PUPOPT LDA PUPFLG ; Get privileged upload status ORA A ; Privileged xfr option request? LDA XDRV JNZ CONT2 ; Yes, exit, takes next priority ENDIF ; IF ZCPR CALL WHLCHK ; WHEEL byte set? LDA XDRV JNZ CONT2 ; WHEEL set, exit, takes next priority ENDIF ; IF SETAREA OR ASKAREA LDA XDRV ; Setarea uses a specified drive MOV B,A SUI 40H STA FCB MOV A,B ENDIF ; IF NOT (SETAREA OR ASKAREA) LDA OLDDRV ; Otherwise get current drive ADI 'A' ; Convert to ASCII NOTDRV: DB 0,0 ; Filled in by 'GETDU' if requested ENDIF ; NOT SETAREA ; CONT2: STA KDRV ; Save drive for KSHOW STA UPDRV ; Also for MSGDESC upload info 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 OR ASKAREA LDA XUSR ; Setarea takes next precedence ENDIF ; IF NOT (SETAREA OR ASKAREA) LDA OLDUSR ; Get current drive for default NOTUSR: DB 0,0 ; Filled in by 'GETDU' if requested ENDIF ; CONT3: STA UPUSR ; Save for MSGDESC upload info MVI H,0 MOV L,A CALL DECOUT ; Print the user area CALL ILPRTB DB ':' DB CR,LF DB 'Disk space available > ',0 CALL KSHOW ; Show available space remaining CALL ILPRTB DB CR,LF,0 CALL CHEKFIL ; See if file exists CALL ILPRTB DB CR,LF DB 'Now ready to receive your Upload(s)',0 ; IF B3RTC AND NOT (MBMXT OR BYEBDOS) CALL GETTOS ; Get time on system SHLD TOSSAV ; Save it for exit ENDIF ; LDA PRVTFL ; To the private area? ORA A JNZ CONT6 ; Yes, don't mention descriptions ; IF (DESCRIB OR MSGDESC) AND ACCESS AND PUPOPT LDA PUPFLG ORA A ; Privileged xfr option request? JZ CONT5 ; No ; CONT4: CALL ILPRTB DB CR,LF DB 'Description(s) will not be required',0 JMP CONT6 ENDIF ; IF DESCRIB OR MSGDESC CONT5: CALL ILPRTB DB CR,LF DB 'Description(s) are needed when done',0 ENDIF ; CONT6: CALL ILPRTB DB CR,LF DB ' To abort: CTRL-X [pause] CTRL-X',CR,LF,0 CALL ILPRTL ; Show locally only DB CR,LF DB ' [ waiting ]',CR,0 RET ; ; ; 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 JZ RCVSABT ; Abort and erase the zero length file CALL SNDACK ; Ack the record CALL WRBLOCK ; Write the last block CALL CLOSFIL ; Close the file ; ; Write record to log file if LOGCAL is YES ; RCVEO1: IF LOGCAL LHLD RECDNO ; If yes, get # of records SHLD RCNT ; And stuff in RCNT CALL XTIM ; Calculate approximate transfer time CALL STORTIM ; Store the time CALL LOGCALL ENDIF ; IF LOGLDS LDA UPLDS ; Get Upload Counter INR A ; One more upload since log in STA UPLDS ; Update Counter ENDIF ; LOGLDS ; CALL ALLDON ; If not in BATCH, print transfer complete ; ; ; ================== ; Credit routines: ; ================== ; CRED: IF CREDIT LDA BCHFLG ; In batch mode now? ORA A JNZ CRED1 ; If yes, skip following messages ENDIF ; IF CREDIT AND MSGFIL LDA MSGFLG ORA A ; Message file uploaded? JNZ CRED4 ; Yes, so skip thanks, credit and description ENDIF ; IF CREDIT AND ACCESS AND PUPOPT LDA PUPFLG ; Get privileged transfer option flag ORA A ; Requested? JNZ CRED4 ; Else skip thanks, credit and description ENDIF ; IF CREDIT AND ZCPR CALL WHLCHK ; Is it the Sysop? JNZ CRED3 ; Yes, skip the thanks and credit ENDIF ; CRED0: IF CREDIT CALL ILPRTB ; Show to remote also DB CR,LF DB 'Thank you for the upload!',CR,LF DB 'The time you took to upload has been added',CR,LF DB 'to your remaining system time for today.',CR,LF,0 ENDIF ; CRED1: IF CREDIT AND (NOT BYEBDOS) PUSH PSW LHLD RECDNO ; Get # of records SHLD RCNT ; And stuff in RCNT CALL XTIM POP PSW ENDIF ; IF CREDIT AND B3RTC AND MBMXT AND (NOT BYEBDOS) CALL BYECHK JNZ CRED2 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 CRED3 ; 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 CRED2 ; MAK255: MVI A,255 ; If up to max, make sure they don't MOV M,A ; Get LESS than what they had.. ENDIF ; IF CREDIT AND B3RTC AND NOT (BYEBDOS OR MBMXT) CALL BYECHK JNZ CRED2 ; 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 CREDIT AND BYEBDOS AND (NOT B3RTC) LDA MAXTOS ; Get maximum time allowed ORA A JZ CRED2 ; If zero, he's a super-guy anyway PUSH PSW LHLD RECDNO SHLD RCNT CALL XTIM POP PSW 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 ENDIF ; IF CREDIT CRED2: INR A ; Set to local display only STA CONONL ENDIF ; ; If not still in BATCH mode, ask for file description ; LDA BCHFLG ; In BATCH receive? ORA A JNZ CRED4 ; If yes, skip asking for a description ; CRED3: IF DESCRIB OR MSGDESC CALL RSTLCK ; Clear WRTLOC before descriptions CALL ASK ; If yes, ask for description(s) ENDIF ; CRED4: JMP DONE ; ; ; ================== ; WRTLOC routines: ; ================== ; SETLCK: IF WRTLOC AND (NOT BYEBDOS) 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 ENDIF ; IF WRTLOC AND BYEBDOS MVI C,75 ; Set/Get writeloc function MVI E,1 ; Turn on WRTLOC flag CALL BDOS ENDIF ; RET ; ; RSTLCK: IF WRTLOC AND (NOT BYEBDOS) 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 XRA A ; Clear it MOV M,A ; (so ctrl-C/ctrl-K work) ENDIF ; IF WRTLOC AND BYEBDOS MVI C,75 ; Set/Get writeloc function MVI E,0 ; Turn off WRTLOC flag CALL BDOS ENDIF ; RET ; ; ; ====================== ; BATCH Mode Routines: ; ====================== ; ; If in batch receive, gets a file name from the buffer then asks for a ; description. ; BCHDCR: LDA FILCNT DCR A STA FILCNT ; BCHD1: LHLD NBSAVE ; Get address of next batch filename LXI D,FCB ; Where to put it MVI B,12 CALL MOVE SHLD NBSAVE ; Store address for next filename RET ; ; If receiving batch, increment the file count, store the filename so we ; can later ask for a description. ; BCHINR: LHLD NBSAVE ; Where to put the name LXI D,FCB ; Where to get the name XCHG MVI B,12 ; Move the current file name into buffer CALL MOVE XCHG SHLD NBSAVE ; Store address for next filename LDA FILCNT ; Increment the file count INR A STA FILCNT RET ; BCHINR1:LDA FILCNT CPI 50 ; Received BATCH transfer limit yet? RC CALL ILPRTL DB CR,LF DB '++ No more than 50 files in BATCH mode ++',CR,LF,0 XRA A STA BCHFLG ; Reset the batch mode flag to zero POP H ; Reset stack from "CALL BCHINR" JMP CRED4 ; Update TOS byte and exit ; ; Loads a command line addressed by 'DE' registers (max # characters in ; line in 'DE', number of characters in line in DE+1, line starts in ; DE+2) into FCB addressed by 'HL' registers. The FCB should be at ; least 33 bytes in length. The command line buffer must have a maxi- ; mum length at least one more than the greatest number of characters ; that will be needed. ; CMDLINE:PUSH PSW PUSH B PUSH D PUSH H CALL INITIAL ; Fills FCBs with blanks and nulls XCHG ; Get start of command line in HL INX H ; Address # bytes in command line MOV E,M ; Load DE pair with # bytes MVI D,0 INX H DAD D ; Point to byte after last character MVI M,CR ; In command line and store delimiter POP H ; Restore HL and DE POP D PUSH D PUSH H INX D ; Address start of command INX D CALL DRIVEX MVI C,8 ; Transfer first filename to FCB CALL TRANS CPI CR JZ DONEL CPI ' ' ; If space, then start of 2nd filename JZ NAME1 POP H ; Filetype starts after 8th byte PUSH H LXI B,9 DAD B MVI C,3 ; Transfer type of first file CALL TRANS CPI CR JZ DONEL ; NAME1: LDAX D ; Eat multiple spaces between names CPI ' ' JNZ NAME2 INX D JMP NAME1 ; NAME2: POP H ; Second name starts in 16th byte PUSH H ; Point HL to this byte LXI B,16 DAD B CALL DRIVEX MVI C,8 CALL TRANS CPI CR JZ DONEL POP H ; Second file type starts in 25th byte PUSH H LXI B,25 DAD B MVI C,3 CALL TRANS ; DONEL: POP H PUSH H INX H ; Point to 1st char of 1st name in FCB CALL SCANL ; Check for * (ambiguous names) POP H PUSH H LXI B,17 ; To 1st character of second name in FCB DAD B CALL SCANL POP H POP D POP B POP PSW RET ; ; Subroutines for CMDLINE section ; INITIAL:PUSH H ; Initializes FCB with 1 null for first PUSH B ; Drive with 11 blanks, 4 nulls, 1 MVI M,0 ; Null for second drive with 11 blanks INX H ; And 4 nulls MVI B,11 MVI A,' ' CALL INITFILL MVI B,5 XRA A CALL INITFILL MVI B,11 MVI A,' ' CALL INITFILL MVI B,4 XRA A CALL INITFILL POP B POP H RET ; INITFILL: MOV M,A INX H DCR B JNZ INITFILL RET ; ; Show batch files remaining after this one is sent ; CUMSTS: CALL ILPRTL DB CR,LF DB 'Files remaining > ',0 LDA SHOCNT ; Get cumulative files DCR A STA SHOCNT ; Less one MOV L,A MVI H,0 CALL DECOUT CALL ILPRTL DB CR,LF DB 'Ymodem packets remaining > ',0 CALL CUMSTS1 CALL DIVREC ; Divide number of records by 8 CALL DECOUT CALL ILPRTL DB CR,LF DB 'Xmodem packets remaining > ',0 CALL CUMSTS1 SHLD TOTREC CALL DECOUT ; Show remote remaining records CALL ILPRTL DB CR,LF,LF,0 RET ; CUMSTS1:LHLD RCNT ; Get this file's record count again XCHG ; Put in DE LHLD TOTREC ; Total records remaining MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A JNC $+6 LXI H,0 ; In case of a slightly negative number RET ; ; ============= ; DRIVEX: INX D ; Check 2nd byte of filename. If it is LDAX D ; a ":", then a drive was specified. DCX D CPI ':' JNZ DEFDR ; Else zero for default drive LDAX D ; ('INIT' put zero) CALL UCASE ; Convert to uppercase SUI 40H ; Calculate drive (A=1, B=2,...) MOV M,A ; Place it in FCB INX D ; Address first byte in command line INX D ; DEFDR: INX H ; And name field in FCB RET ; ; ============= ; ; Clears the FCB area ; INITFCB:MVI M,0 ; Clears the drive ; INITFCB1: INX H MVI B,11 ; Clears the filename and extent area ; LOOP11: MVI M,' ' INX H DCR B JNZ LOOP11 MVI B,21 ; Clears the rest with zeros ; LOOP21: MVI M,0 INX H DCR B JNZ LOOP21 RET ; ; Finished with the file transfer ; DONE: LDA BCHFLG ; In batch mode now? ORA A JZ EXIT ; If not, all done so go finish up LDA OLDDRV ; Restore the original drive CALL RECDRX LDA OLDUSR ; Restore the original number CALL RECARE MVI C,STDMA LXI D,TBUF ; Reset to default DMA address CALL BDOS MVI B,12 ; Zero out DONE6 LXI H,DONE6 ; ; Null the batch file name buffer ; DONE1: MVI M,0 ; Zero the memory location INX H DCR B JNZ DONE1 ; Zero all 12 locations ; ; Now fill in the batch file name ; MVI B,12 ; Put file name in DONE6 LXI H,FCB+1 LXI D,DONE6 ; DONE2: MVI A,4 ; Start of file type? CMP B JZ DONE4 ; Put in period if so MOV A,M CPI ' ' ; Don't put in space JZ DONE3 STAX D ; Store in DONE6 INX D ; DONE3: INX H DCR B MOV A,B ORA A ; End of file name? JZ DONE5 ; Display file name JMP DONE2 ; Loop for another character ; DONE4: MOV A,M CPI ' ' ; Is file type empty? JZ DONE5 ; Go if so MVI A,'.' ; Else put period in message STAX D INX D DCR B JMP DONE2 ; DONE5: MVI A,1 ; Display filename locally only STA GOTONE ; Indicates there was a file handled CALL ILPRTL ; Display the file name DB CR,LF ; DONE6: DB 0,0,0,0,0,0,0 DB 0,0,0,0,0,0 CALL ILPRT DB ' transferred',CR,LF,0 ; ; Now reset some flags for another possible batch file ; XRA A STA EOFLG ; Clear end of file flag STA EOTFLG ; And end of transmission flag STA CHKEOT ; Clear the "resend EOT" flag LXI H,0 SHLD ACCERR ; Reset the accumulate error count SHLD RECNBF ; Zero number of records in the buffer SHLD RECDNO ; Zero the current record number SHLD RCDCNT ; Zero the transmit record counter LXI H,DBUF ; Reset buffer pointers SHLD RECPTR LDA SNDFLG ; Goes to either send or ORA A ; Receive file, depending JZ SNDFL ; Upon which routine set CALL BCHINR1 ; Store filename, increment the count JMP RCVFL ; The flag in multi-file mode ; ; ; =============================== ; Multi-file access subroutine: ; =============================== ; ; Allows processing of multiple files (i.e., *.ASM) from disk. Builds the ; correct name in the FCB each time it is called. The command is used in ; programs to process single or multiple files. The FCB is set up with the ; next name, ready to do normal processing (open, read, etc.) when routine ; is called. Carry is set if no more names are found. ; MFNAM: PUSH B PUSH D PUSH H MVI C,STDMA LXI D,TBUF CALL BDOS POP H POP D POP B XRA A STA FCBEXT LDA MFFLG1 ORA A JNZ MFNAM1 MVI A,1 STA MFFLG1 LXI H,FCB LXI D,MFNAM5 LXI B,12 CALL MOVER LDA FCB STA MFNAM6 ; Save disk in current FCB LXI H,MFNAM5 LXI D,FCB LXI B,12 CALL MOVER PUSH B PUSH D PUSH H MVI C,SRCHF LXI D,FCB CALL BDOS POP H POP D POP B JMP MFNAM2 ; MFNAM1: LXI H,MFNAM6 LXI B,12 LXI D,FCB CALL MOVER PUSH B PUSH D PUSH H MVI C,SRCHF LXI D,FCB CALL BDOS POP H POP D POP B LXI H,MFNAM5 LXI D,FCB LXI B,12 CALL MOVER PUSH B PUSH D PUSH H MVI C,SRCHN LXI D,FCB CALL BDOS POP H POP D POP B ; MFNAM2: INR A STC JNZ MFNAM3 STA MFFLG1 RET ; MFNAM3: DCR A ANI 3 ADD A ADD A ADD A ADD A ADD A ADI 81H MOV L,A MVI H,0 PUSH H ; Save name pointer LXI D,MFNAM6+1 LXI B,11 CALL MOVER POP H LXI D,FCB+1 LXI B,11 CALL MOVER XRA A STA FCBEXT STA FCBRNO RET ; MOVER: MFNAM4: MOV A,M ; Used if an 8080 CPU is active STAX D INX H INX D DCX B MOV A,B ORA C JNZ MFNAM4 RET ; ; ; ============================ ; MB-KMD receive batch mode: ; ============================ ; RCVFN: LXI H,FCB CALL INITFCB1 ; Does not initialize drive XRA A STA RCVTRY INR A ; Set to local display only STA CONONL ; RKMD1: CALL CKABORT ; Check for user abort MVI B,3 ; Wait up to 3 sec. for SOH from remote CALL RECV JC RKMD2 ; No character, decrement counter CPI CANCEL ; Was it a CTL-X for cancel? JZ ABORTX ; Abort if yes CPI SOH JZ RKMD4 ; Got SOH JMP RKMD1 ; None of these, wait some more ; RKMD2: MVI A,CRC ; Send a 'C' CALL SEND ; RKMD3: LDA RCVTRY INR A STA RCVTRY CPI 33 JC RKMD1 JMP ABORT ; Quit and try to force him to quit also ; RKMD4: MVI B,5 ; 5 seconds to get sector number CALL RECV JC KMDTOT MOV D,A ; Save sector number in D ORA A ; Must be a 0 if sending batch JNZ KMDHDR MVI B,5 ; 5 seconds to get reciprocal CALL RECV JC KMDTOT CMA ; Invert it and compare to sector # CMP D JNZ KMDCRC ; Bad match LXI H,0 SHLD CRCVAL ; Clear CRC counter MVI E,128 ; Expecting a 128 character block LHLD RECPTR ; Point to the buffer address ; RKMD5: MVI B,5 ; 5 seconds to get 128 byte header block CALL RECV ; Get the character JC KMDTOT ; Exit if no character MOV M,A ; Store the character INX H ; Point to next buffer location DCR E ; One less to go JNZ RKMD5 ; MVI E,2 ; Number of CRC bytes to get ; RKMD6: MVI B,5 CALL RECV ; Get CRC bytes JC KMDTOT DCR E ; Done? JNZ RKMD6 ; No CALL CRCCHK ; Compare CRC received against ours ORA A ; Ok? JNZ KMDCRC ; No CALL SNDACK ; Yes, acknowledge to remote ; ; Decode pathname into CPM format ; LXI D,FCB+1 ; Where to put it LHLD RECPTR ; Where to get it MVI B,8 ; Filename length ; RKMD7: MOV A,M ; Get the character from the buffer ORA A ; Was it a zero? JZ RKMD12 ; If yes, all done CPI '.' ; Was it a delimiter? JZ RKMD9 ; RKMD8: CALL UCASE ; Insure name is in upper case STAX D ; Store filename character in FCB INX D ; Increment pointers INX H DCR B ; One less to go JNZ RKMD7 ; If not 8, keep going MOV A,M ; Get the character back ORA A ; We had 8, was there an extent? JZ RKMD11 ; If zero, was all done JMP RKMD10 ; Else must be a '.' ; RKMD9: MVI A,' ' ; Spaces to make up 8 spaces for name STAX D ; Store space character in FCB INX D ; Increment pointers DCR B ; One less to go JNZ RKMD9 ; Keep going until in extent area ; RKMD10: INX H ; Skip the '.' position MVI B,3 ; Extent length RKMD11: MOV A,M ; Get the character from the buffer ORA A ; Was it a zero? JZ RKMD12 ; If yes, all done CALL UCASE ; Insure extent is in upper case STAX D ; Store extent character INX D ; Increment pointers INX H DCR B ; One less to go JNZ RKMD11 ; Keep going until finished ; RKMD12: LDA FCB+1 ; See if there was any filename at all CPI ' ' STC ; If not set the carry flag RZ ; No, all done, no more files CALL CLEARIT ; Clear screen locally if suppose to CALL ILPRTL DB CR,LF DB 'Name of this file > ',0 LHLD RECPTR ; Print filename ; RKMD13: MOV A,M ORA A JZ RKMD14 CALL UCASE CALL CTYPE INX H JMP RKMD13 ; RKMD14: LHLD BUFSTR ; Get the file length, if provided MOV A,H ORA L JZ RKMD15 ; If both zero, length not provided SHLD RCNT ; Store the file length CALL OPNOK3 CALL ILPRTL DB CR,LF DB 'Ymodem transfer time > ',0 LDA MSPEED ; Get speed indicator CPI 5 ; Are we less than 1200 bps? JC RKMD14A ; Yes, jump to CALL XTIM CALL KTIM CALL OPNOK4 JMP RKMD15 ; RKMD14A:CALL XTIM ; Else, show 128-byte transfer time CALL OPNOK4 ; RKMD15: CALL ILPRTL DB CR,LF,0 ; Finish the filename line XRA A ; Reset the carry flag STA RCVTRY ; Reset the error counter RET ; KMDCRC: CALL ILPRTL DB '++ CRC error ++',CR,LF,0 JMP KMDXFR ; KMDHDR: CALL ILPRTL DB '++ Wrong header type ++',CR,LF,0 JMP KMDXFR KMDTOT: CALL ILPRTL DB '++ Timeout receiving filename ++',CR,LF,0 ; KMDXFR: CALL WAIT1 ; Make sure sender has stopped CALL WAIT1 MVI A,NAK ; Tell sender it was not successful CALL SEND LDA RCVTRY ; Increment the error counter INR A STA RCVTRY CPI 33 JC RKMD3 ; Send a NAK and tell him to try again JMP ABORT ; Else abort ; ; ; ========================= ; MB-KMD send batch mode: ; ========================= ; SNDFN: SNDKMD: LXI H,FCB CALL INITFCB1 ; Does not initialize drive XRA A STA ERRCT ; Reset the error count CALL CATCH ; Clear the decks for action MVI E,60 ; Wait up to 60 seconds to abort ; CCHECK: CALL CKABORT ; Manually requesting an abort? MVI B,1 ; Wait up to 1 second for a character CALL RECV JC CCHECK1 ; No character, decrement counter CPI CANCEL ; If they sent a CTL-X, abort now JZ ABORT CPI CRC ; If they sent a CRC, go to work JZ SKMD0 JMP CCHECK ; None of these, wait some more ; CCHECK1:DCR E ; One less to go JNZ CCHECK JMP ACKMSG ; Abort if timed out and no character ; SKMD0: MVI A,1 STA CRCFLG ; Make sure in CRC mode LDA FILCNT ; Get the file count DCR A ; Decrement it for this one STA FILCNT JM KMDEND ; If no more files, abort CALL BCHD1 ; Get the name into FCB LHLD RECPTR ; Where to load the 0 block XCHG ; Put into DE LXI H,FCB+1 ; Get the start of the filname in HL MVI B,8 ; SKMD1: MOV A,M ANI 7FH ; Strip any high bit set ORA A JZ SKMD6 ; Null pathname CPI ' ' JZ SKMD3 ; SKMD2: CALL LCASE ; Put file name in lower case for UNIX STAX D INX H INX D DCR B JNZ SKMD1 JMP SKMD4 ; SKMD3: INX H ; Skip over spaces if short name DCR B JNZ SKMD3 ; SKMD4: MOV A,M CPI ' ' JZ SKMD6 ; Missing file type field MVI A,'.' ; Send name-type seperator STAX D INX D MVI B,3 ; SKMD5: MOV A,M ANI 7FH ; Strip any high bit set CPI ' ' JZ SKMD6 CALL LCASE ; Put in lower case for UNIX STAX D INX H INX D DCR B JNZ SKMD5 ; SKMD6: XCHG ; Get the address back to HL ; SKMD7: MVI M,0 INR L ; Pad to end of block with binary 0 JNZ SKMD7 CALL CNREC ; Get number of records in this file LHLD RCNT SHLD BUFSTR ; Store the file length at end of block XRA A ; Make sure the header starts with Zero STA RCDCNT ; ; Now send the 128-byte file name record ; SKMD8: XRA A STA KFLG MVI A,SOH ; Send SOH CALL SEND CALL SNDHNM ; Send header (record number, inverse) CALL SNDREC ; Send a 128 byte record CALL SNDCRC ; Send a two byte CRC MVI B,5 CALL RECV ; Get acknowledgement of good send CPI ACK JNZ KMDBAD ; Bad name send LDA MSPEED ; Check speed being used CPI MINKSPD JC SKMD9 ; Don't allow 1k blocks if 300 bps MVI A,1 STA KFLG ; Change to 1k for normal file xfer ; SKMD9: XRA A ; Clear the carry flag STA ERRCT ; Start fresh for the main file RET ; KMDBAD: CPI CANCEL ; Was it a CTL-X for cancel? JZ ABORT ; Abort if yes CALL ILPRTL ; Bad name block DB '++ CRC error ++',CR,LF,0 LDA ERRCT ; Increment the error counter INR A STA ERRCT CPI 10 JC SKMD8 ; If not timed out, try again JMP ACKMSG ; Else abort ; KMDEND: XRA A ; Reset the pointers LHLD RECPTR MOV M,A STA RCDCNT ; Reset the record counter STA KFLG ; Show in 128 size now MVI A,SOH ; Send a start of header CALL SEND CALL SNDHNM ; This header is a zero count CALL SNDREC ; Send an empty record CALL SNDCRC ; Send the CRC for the empty record STC ; Set the carry flag to show all done RET ; ; Scans CMDBUF counting names - putting delimiter (space) after last name ; SCAN: LXI D,CMDBUF ; Save original TBUF contents in CMDBUF LXI H,TBUF MVI B,128 CALL MOVE LXI H,CMDBUF MOV C,M MVI B,0 INX H DAD B ; Now pointing at space after last char MVI M,' ' ; Put in the space LXI H,CMDBUF ; Get the count again MOV B,M INX H ; Skip the first space INR B ; SCAN1: INX H ; On first entry HL points to 1st char DCR B ; 1st go-thru B is count to last space JZ SCAN5 MOV A,M ; Look for the first space CPI ' ' JNZ SCAN1 ; SCAN2: INX H ; Eat extra spaces DCR B JZ SCAN5 MOV A,M CPI ' ' JZ SCAN2 SHLD BGNMS ; Save start of names in TBUFF INR B DCX H ; SCAN3: INX H DCR B JZ SCAN5 MOV A,M CPI ' ' JNZ SCAN3 LDA NAMECT ; Counts names INR A STA NAMECT ; SCAN4: INX H ; Eat spaces DCR B JZ SCAN5 MOV A,M CPI ' ' JZ SCAN4 JMP SCAN3 ; SCAN5: LDA NAMECT ; Were there any names? ORA A RNZ ; Yes POP H ; Remove calls from stack POP H JMP OPTERR ; Bail out to avoid BDOS error ; SCANL: MVI B,8 ; Scan file name addressed by HL ; TSTNAM: MOV A,M CPI '*' ; If '*' found, fill in rest of field JZ FILL1 ; With '?' for ambiguous name. INX H DCR B JNZ TSTNAM JMP FILL2 ; FILL1: CALL FILL4 ; FILL2: MVI B,3 ; Scan and fill name 'type' field ; FILL3: MOV A,M ; Specified above CPI '*' JZ FILL4 INX H DCR B JNZ FILL3 RET ; FILL4: MVI M,'?' ; Routine transfers '?' INX H DCR B JNZ FILL4 RET ; ; ; ============= ; ; Show the file name (locally) as stored in the FCB but in CP/M format ; SHOWFIL:LDA FSTFLG ; Have we been here before? CPI 1 JNZ SHOWFIL1 ; Yes, then already cleared screen INR A ; No, increment FSTFLG so it's not 1 next time STA FSTFLG ; Store it CALL CLEARIT ; Clear local screen ; SHOWFIL1: CALL ILPRTL ; Show on local CRT only DB CR DB 'Name of this file > ',0 LXI H,FCB+1 XRA A STA FTYCNT MVI C,11 ; PRNAM: CALL FTYTST INX H DCR C JNZ PRNAM RET ; FTYTST: LDA FTYCNT INR A STA FTYCNT CPI 9 ; Are we at the file type? JZ SPCTST ; Go if so ; ENDSPT: MOV A,M CPI ' ' ; Test for space CNZ CTYPE ; Type if not RET ; SPCTST: MOV A,M CPI ' ' ; Test for space in 1st file type byte RZ ; Do not output period if space MVI A,'.' CALL CTYPE JMP ENDSPT ; Output 1st file type byte ; ; ; ============= ; ; Loads the batch file names into the storage buffer ; TNMBUF: XRA A STA FILCNT ; Reset the file count CALL SCAN LXI H,NAMBUF ; Start of buffer into NBSAVE SHLD NBSAVE ; Save address of 1st name ; TNLP1: CALL TRTOBUF ; Move a filename into FCBBUF LXI H,FCB LXI D,FCBBUF CALL CMDLINE ; Parse name to CP/M format ; TNLP2: CALL MFNAM ; Search for names (wildcard format) JC NEXTNM MVI C,FILSIZ LXI D,FCB CALL BDOS LHLD RANDOM ; Get number of records in this file MOV A,H ORA L JZ TNLP2 ; If no records, don't copy this file SHLD DIRSIZ ; Save temporarily ; CALL WHLCHK ; Wheel byte set for SYSOP use? JNZ TNLP3 ; If yes, let him transfer any file ; IF TAGFIL LDA FCB+1 ; Tagged library file to not send? ANI 80H JNZ TNLP2 ; If set, do not send LDA FCB+2 ; Special tag? ANI 80H JNZ TNLP2 ; If set, do not send ENDIF ; IF NOSYS LDA FCB+10 ; It is a .SYS file? ANI 80H JNZ TNLP2 ; If set, do not send ENDIF ; IF NOLBS OR NOCOMS LXI H,FCB+11 ; Last character in the file extent MOV A,M ANI 7FH ; Strip off the high bit ENDIF ; IF NOLBS CPI '#' JZ TNLP2 ; If set, do not send ENDIF ; IF NOCOMS CPI 'M' ; Do not allow '.COM' files to be sent JNZ TNLP3 ; If not, file is ok to send DCX H MOV A,M ANI 7FH ; strip any high bit CPI 'O' JNZ TNLP3 ; If not, file is ok to send DCX H MOV A,M ANI 7FH ; Strip off any high bit set CPI 'C' JZ TNLP2 ; If yes, ignore file ENDIF ; TNLP3: LHLD NBSAVE ; Get the filename LXI D,FCB ; Move it to FCB XCHG MVI B,12 CALL MOVE XCHG SHLD NBSAVE ; Address of next name LDA FILCNT ; Count files found INR A STA FILCNT ; ; Add up the total records for all files to be sent ; LHLD DIRSIZ ; Get number of records in this file PUSH H ; Save for later XCHG ; Put record count into 'DE' LHLD TOTREC ; Get record count up to this file DAD D ; Add this file to previous total SHLD TOTREC ; New total record count POP H ; Get the length of this file LXI D,15 ; Bring up to closest 2k size DAD D INX D ; Divide result by 16 CALL DVHLDE ; Divide HL by DE MOV H,B MOV L,C ; NOREM: XCHG LHLD BLOKK ; Current number of 2k blocks needed DAD D SHLD BLOKK JMP TNLP2 ; NEXTNM: PUSH D ; Save D, following BDOS calls use it LDA OLDDRV CALL RECDRX ; Restore default drive LDA OLDUSR CALL RECARE ; Restore default user POP D LXI H,NAMECT ; Count names found DCR M JNZ TNLP1 LXI H,NAMBUF ; Save start of buffer SHLD NBSAVE RET ; ; ; ============= ; TRANS: LDAX D ; Transfer from command line to FCB INX D ; Up to number of chars specified CPI CR ; By 'C' reg. Keep scanning field RZ ; Without transfer until a delimiting CPI '.' ; Field char such as '.', blank, or RZ ; CR (for end of commmand line). CPI ' ' RZ DCR C JM TRANS ; Once C-reg is less than zero, keep MOV M,A ; Reading command line but do not INX H ; Transfer to FCB. JMP TRANS ; ; ; ============= ; ; Places next name in buffer so 'CMDLINE' may parse it ; TRTOBUF:LHLD BGNMS MVI B,0 LXI D,FCBBUF+2 ; TBLP: MOV A,M CPI ' ' JZ TRBFEND STAX D INX H INX D INR B ; Count chars in name JMP TBLP ; TRBFEND:INX H MOV A,M ; Eat extra spaces CPI ' ' JZ TRBFEND SHLD BGNMS LXI H,FCBBUF+1 ; Put # chars before name MOV M,B RET ; ; ; ============= ; ; This routine converts character in 'A' to lowercase. ; LCASE: CPI 41H ; If less than capital 'A' ignore RC CPI 5AH+1 ; If more than capital Z' ignore RNC ORI 20H ; Change to lower case RET ; ; This routine converts character in 'A' to uppercase. ; UCASE: CPI 61H ; Changes lower case character.. RC ; ...in 'A' register to upper case. CPI 7AH+1 ; See if more than small 'Z' RNC ANI 5FH RET ; ; ; ============== ; Subroutines: ; ============== ; ; Check to see if BYE is running before getting CONOUT, checking your ACCESS ; byte or setting/resetting WRTLOC. This routine also returns the address of ; the original cold boot routine in DE. ; BYECHK: IF BYEBDOS MVI C,32 ; This bizzare 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) 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 CALL UCASE ; Convert to upper case if needed CPI 'B' ; Try to match 'BYE' RNZ ; Out if BYE not active INX H MOV A,M CALL UCASE ; Convert to upper case if needed CPI 'Y' RNZ INX H MOV A,M CALL UCASE ; Convert to upper case if needed CPI 'E' RET ENDIF ; ; Catches anything on the modem input and ignores, so can wait for what we ; expect to receive ; CATCH: CALL MDINST ; Check modem status for any characters RNZ ; If none, all checked CALL MDINP ; Else get the garbage character JMP CATCH ; Keep going until none remaining ; ; Check next character to see if a space or non-space, file name error if no ; ASCII character. ; CHKFSP: LDA BCHFLG ; Requesting batch mode now? ORA A JZ CHKFSP2 ; Exit if not LDA SNDFLG ; Sending batch? ORA A JZ CHKFSP2 ; If yes, exit DCR B JZ CHKFSP1 INR B JMP CHKFSP2 ; CHKFSP1:POP H ; Do not return to LOGDU RET ; Return instead to SNDFL ; CHKFSP2:DCR B JZ NFN ; Error if end of chars. MOV A,M CPI ' '+1 RNC ; Ok if valid character so return INX H LDA BCHFLG ; Requesting batch mode? ORA A JZ CHKFSP2 ; If not, loop LDA SNDFLG ; Sending batch mode now? ORA A JZ CHKFSP2 ; If yes, loop DCR B ; Else look at next character JZ CHKFSP1 INR B JMP CHKFSP2 ; ; Check next character to see if a space or non-space, go to menu if a command ; error. ; CHKSP: LDA BCHFLG ; Requesting batch mode? ORA A JZ CHKSP2 ; Exit if not LDA SNDFLG ; Sending in batch mode now? ORA A JZ CHKSP2 ; If yes, exit DCR B JZ CHKSP1 INR B JMP CHKSP2 ; CHKSP1: POP H ; Don't return to LOGDU RET ; Return to SNDFIL ; CHKSP2: DCR B JZ OPTERR INX H MOV A,M ; Get the character there CPI ' ' ; Space character? RET ; JZ = space, JNZ = non-space ; ; ; ============================== ; Finished, clean up and EXIT: ; ============================== ; EXIT: CALL CATCH ; Clear any garbage from line CALL RSTLCK ; Reset WRTLOC if needed ; IF (TIMEON OR DTOS) AND TOSEXIT MVI A,0 STA CONONL ; Show time info to both consoles CALL TIME ; print time-on-system ENDIF ; EXIT1: LDA OLDDRV ; Restore the original drive CALL RECDRX LDA OLDUSR ; Restore the original number CALL RECARE MVI C,STDMA LXI D,TBUF ; Reset to default DMA address CALL BDOS ; EXIT2: IF BYEBDOS LDA MAXTOS ; Restore MAXTIME/status MOV E,A MVI C,81 CALL BDOS ENDIF ; EXIT3: XRA A ; Clear the register and carry bit LHLD STACK ; Get original return adress back SPHL ; Put on the stack pointer ; IF MSGFIL OR MSGDESC AND (NOT DESCRIB) LDA DSCFLG ORA A ; Normal file with description? JNZ EXIT4 LDA MSGFLG ORA A ; Message file upload? RZ ; No ; EXIT4: CALL ILPRTB ; Show to remote also DB CR,LF,LF DB 'Loading special message file handler',CR,LF,LF,0 INR A STA CONONL ; Set to local display only MVI C,0 ; Number of characters (stuff at TBUF) LXI D,TBUF+1 ; Start of buffer CALL MBDFIL STA TBUF ; Save number of characters in TBUF MVI A,0C2H ; Stuff C2H (JNZ instruction) STA 0 ; ...in 0, so BYE loads/runs msg file utility ORA A ; Make sure NZ flag set so JNZ will jump JMP 0 ENDIF ; IF NOT (MSGFIL OR MSGDESC) RET ENDIF ; IF MSGFIL OR (MSGDESC AND (NOT DESCRIB)) MBDFIL: LDA DSKSAV ; Get current drive INR A ; MWDRV: ADI 'A'-1 CALL MBDPUT ; Stuff in command line buffer LDA USRSAV ; Get current user CPI 10 ; <10? JC US0 ; Yes 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 LDA DSCFLG ORA A JZ US1 LXI H,FILE+1 JMP US2 US1: LXI H,FCB+1 ; Stuff in filename without spaces ; US2: MVI B,8 ; DESNM: MOV A,M ANI 7FH ; Strip 7th bit in case $SYS file CPI ' ' CNZ MBDPUT INX H DCR B JNZ DESNM MVI A,'.' CALL MBDPUT MVI B,3 ; DESNM3: MOV A,M ANI 7FH ; Strip 7th bit in case $SYS file CPI ' ' JZ DESGO CPI 0 JZ DESGO CALL MBDPUT INX H DCR B JNZ DESNM3 ; DESGO: MOV A,C RET ; MBDPUT: STAX D ; Short routine to stuff A in (DE) and INX D ; increment pointer and character count INR C RET ENDIF ; ; Check to see if SYSOP has typed a function key ; FUNCHK: PUSH B ; Save everything PUSH D ; (to be safe) PUSH H PUSH PSW ; CONCHK: CALL 0000H ; Address patched in by START POP PSW ; For BIOS JMP CONSTAT POP H POP D POP B ; Restore everything RET ; ; Get Disk and User from DUSAVE and log in if valid. ; GETDU: LDA BCHFLG ; Requesting batch mode? ORA A JZ GETDU1 ; If not, exit LDA SNDFLG ; Sending batch? ORA A JNZ GETDU2 ; If not, exit ; GETDU1: CALL CHKFSP ; See if a file name is included SHLD SAVEHL ; Save location of the filename ; GETDU2: LDA PRVTFL ; Uploading to a private area? ORA A JNZ TRAP1 ; 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 GETDU3 CPI '9'+1 JC NUMER1 ; GETDU3: STA RCVDRV ; Allows SYSOP to upload to any drive CPI 'A'-1 JC NUMER ; Satisfied with current drive SUI 'A' STA DUD ; IF ACCESS AND PUPOPT LDA PUPFLG ; Privileged user upload request? ORA A LDA DUD ; Get value back JNZ GETDU4 ; Yes ENDIF ; IF ZCPR CALL WHLCHK LDA DUD ; Get the value back JNZ GETDU4 ENDIF ; ZCPR ; 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 ; GETDU4: INX H ; Get 2nd character ; NUMER: MOV A,M CPI ':' JZ OK4 ; Colon for drive only, no user number CALL CKNUM ; Check if numeric MOV B,A ; Save character LDA BCHFLG ; Using batch mode? ORA A JZ NUMER1 ; Skip next part if not using batch LDA SNDFLG ; Receiving in batch? ORA A JNZ NUMER1 ; Yes, can use normal drive/user ; NODU: CALL ERXIT DB '++ Specification of user areas in BATCH is not valid ++','$' ; NUMER1: MOV A,B ; Get the value back 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 ZCPR CALL WHLCHK ; SYSOP using the system? 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 OR ASKAREA) 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 OR ASKAREA) ADI 'A' STA NOTDRV+1 ; Store requested drive MVI A,3EH ; 'MVI A,--' instruction STA NOTDRV ENDIF ; OK5: MVI C,SELDSK CALL BDOS ; Set to requested drive PUSH B CALL WAIT1 ; 1 second delay POP B JMP TRAP1 ; Now find file selected ; ; Downloading from the special private area, set that drive/user ; SETSPL: MVI C,SETUSR ; Set to requested user area MVI E,SPLUSR ; Get the special download area CALL BDOS MVI C,SELDSK MVI E,SPLDRV-'A' ; Get the special download drive JMP BDOS ; Set to requested drive, return ; ; 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 or ASKAREA equate is not set YES.) ; 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 now so that the FREE figure will not ; reflect either the creation or additions to the SD.DIR file (which we would ; probably erase or move anyway). ; 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 allocation 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 ILPRTB DB 'k free',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: LDA SPLFL ; Downloading from a private area? ORA A CNZ SETSPL ; If yes, set special drive/user area ; TRAP1: 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? JZ NFN ; Yes, check for ambigous file name 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 ; NFN: CALL ERXIT ; Print message, exit DB '++ No file name(s) requested ++','$' ; TRERR: LDA BCHFLG ORA A RNZ ; Wildcards are ok in batch mode CALL ERXIT ; Print message, exit DB '++ Wild-card options valid only in BATCH modes ++','$' ; 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 '++ Invalid drive/user combination ++','$' ; ; Receive a record - returns with carry bit set if EOT received ; RCVRECD:XRA A ; Initialize error count to zero STA ERRCT ; RCVRPT: CALL CKABORT ; Check function keys MVI B,10 ; 10-seconds to get first character LDA FRSTIM ; Have we started, yet? ORA A JNZ $+5 ; If yes, skip next line MVI B,3+1 ; Check every 4 seconds until started CALL RECV ; Get any character received JC RCVSTOT ; Timeout error if no character received CPI SOH ; See if it is SOH JZ RCVSOH ; Got SOH, get record CPI STX ; See if it is STX for 1k blocks JZ RCVSTX ; Got STR, get record CPI CANCEL ; Was it a CTL-X to abort? JZ CKCAN ; If yes, check for aborting ORA A ; Get another character, if a null JZ RCVRPT CPI 7BH ; V.22 synch character, ignore JZ RCVRPT CPI 0FBH ; V.22 synch character with high bit set JZ RCVRPT CPI EOT ; See if end of transmission JNZ RCVRP1 ; No, continue LDA EOTFLG ; Get EOT flag status ORA A ; Second EOT? STC ; Set carry in case second EOT received RNZ ; Yes, so all done MVI A,NAK STA EOTFLG ; Show EOT received CALL SEND ; Send NAK for double check of EOT JMP RCVLP ; Continue with receive ; RCVRP1: CPI CRC ; Ignore our own character coming back JZ RCVRPT CPI KSND ; Ignore our own character coming back JZ RCVRPT CPI NAK ; Ignore our own character coming back JZ RCVRPT CALL ILPRTL ; Show locally only DB CR,LF,'++ ',0 MOV A,B CALL HEXO CALL ILPRTL DB 'H received not SOH ++',CR,LF,0 ; ; Didn't get SOH or EOT or did not get valid header so purge the line, ; then send NAK. ; RCVSR: CALL WAIT1 ; Get anything coming in and discard CALL CKABORT ; Want to quit now? LDA FRSTIM ; Get first time switch ORA A ; Has first 'SOH' been received? MVI A,NAK JNZ RCVSR1 ; Yes, then send 'NAK' LDA CRCFLG ; Get the 'CRC' flag ORA A ; 'CRC' in effect? MVI A,NAK ; Put 'NAK' in 'A' register JZ RCVSR1 ; No, send the 'NAK' for checksum MVI A,CRC ; Tell sender we have 'CRC' CALL SEND LDA KFLG ; Requesting 1k transmissions? ORA A JZ RCVSR1 ; If not, exit MVI A,KSND ; Tell sender we also have 1k capability ; RCVSR1: CALL SEND ; The 'NAK' or 'CRC' request LDA ERRCT ; Get the error count INR A ; Increment error count STA ERRCT ; Store new value MOV B,A ; Keep the error count for now LDA FRSTIM ; Have we gotten under way yet? ORA A MOV A,B ; get the value back JZ RCVSR2 ; If not, exit CPI 10 ; 10 errors the limit, once under way JNC RCVSABT ; Abort if over the limit CALL RDCOUNT ; Display record count before repeating JMP RCVRPT ; Less than 10, keep going ; RCVSR2: CPI 10 ; 10 times for 1k/CRC yet? (40 seconds) JC RCVRPT ; Keep trying if less XRA A ; Else flip to checksum mode STA CRCFLG MOV A,B ; Get the count back CPI 15 ; Another 5 times for checksum? JC RCVRPT ; If less, try again, quit at 60 seconds ; ; Error limit exceeded, so abort ; RCVSABT:XRA A STA CONONL ; Clear the console-only flag LXI SP,STACK ; Clear the stack just in case CALL CLOSFIL ; Keep whatever we got CALL ILPRTB DB ' ++ Upload has been cancelled ++',0 CALL DELFILE ; Delete received file CALL ERXIT ; Print second half of message DB ' ++ Partial file is deleted ++','$' ; ; Deletes the received file (used if receive aborts) ; DELFILE:MVI C,DELET ; Get function LXI D,FCB ; Point to file CALL BDOS ; Delete it INR A ; Delete ok? RNZ ; Yes, return CALL ERXIT1 ; No, abort DB ' ++ Can''t delete received file ++',CR,LF DB ' ++ or no file was received ++','$' ; ; Aborts with 1 CTL-X if first time flag is not set, two otherwise ; CKCAN: LDA FRSTIM ; First time flag set yet? ORA A JZ RCVSABT ; If not, Abort and close file CALL DELAY ; Wait 100ms to verify pause between CTL-X's CALL MDINST ; Character already waiting? then skip CANCEL JZ RCVRPT MVI B,2 ; Maximum of 2 seconds for extra CTL-X CALL RECV JC RCVRPT ; No additional character, ignore CTL-X CPI CANCEL ; If a 2nd CTL-X, abort and close file JZ RCVSABT JMP RCVRPT ; Else wait for a STX, SOH or timeout ; ; Timed out on receive ; RCVSTOT:CALL EOTCHK ; See if EOT has been received LDA FRSTIM ; First time flag set yet? ORA A JZ RCVSR ; If not, don't show an error CALL ILPRTL ; Show locally only DB '++ Timeout waiting for character ++',CR,LF,0 JMP RCVSR ; Bump error count, etc. ; ; Got a STX - set KFLG for 1k ; RCVSTX: STA KFLG ; Set the 1k flag STA CRCFLG ; Insure in CRC mode for 1k blocks JMP RCVS1 ; ; Got SOH - get block number, block number complemented ; RCVSOH: XRA A STA KFLG ; If SOH, clear the 1k flag ; RCVS1: MVI B,5 ; Timeout = 5 seconds MOV A,B ; Get something to store STA FRSTIM ; Indicate first 'SOH' or 'STX' recvd. CALL RECV ; Get block number JC RCVSTOT ; Got timeout MOV D,A ; Save block number MVI B,5 ; Timeout = 5 seconds CALL RECV ; Get complimented record number JC RCVSTOT ; Timeout CMA ; Get the complement CMP D ; Same as original block number? JZ RCVDATA ; Yes, get data ; ; Got bad record number in header ; CALL ILPRTL DB '++ Error in header ++',CR,LF,0 JMP RCVSR ; Go check error limit and send NAK ; RCVDATA:MOV A,D ; Get record number STA RCVCNT ; Save it MVI C,0 ; Initialize checksum LXI H,0 ; Initialize CRC SHLD CRCVAL ; Clear CRC counter LXI D,128 ; For 128 character blocks LDA KFLG ; Using 1k blocks? ORA A JZ $+6 ; If not, skip next line LXI D,1024 ; If using 1k blocks LHLD RECPTR ; Get buffer address ; RCVCHR: MVI B,5 ; 5 sec timeout CALL RECV ; Get the character JC RCVSTOT ; Timeout MOV M,A ; Store the character INX H ; Point to next character DCX D ; One less to go MOV A,D ; See if 'D' and 'E' are both empty ORA E JNZ RCVCHR ; No, get next character LDA CRCFLG ; Using 'CRC'? ORA A JNZ RCVCRC ; If yes go get 'CRC' ; ; Verify checksum ; MOV D,C ; Save checksum MVI B,5 ; Timeout length CALL RECV ; Get checksum JC RCVSTOT ; Timeout CMP D ; Checksum ok? JZ CHKSNUM ; Yes, exit CALL ILPRTL DB ' - Checksum error',CR,LF,0 JMP RCVSR ; Go check the error limit and send NAK ; ; Got a record, it's a duplicate if equal to the previous number, it's ; OK if previous + 1 record ; CHKSNUM:LDA RCVCNT ; Get received record number MOV B,A ; Save it LDA RCDCNT ; Get previous record number CMP B ; Rrevious record repeated? JZ RCVACK ; If yes 'ACK' to catch up INR A ; Increment by 1 for 120 character block CMP B ; Match this one we just got? JNZ ABORT ; No match, stop the sender, exit RET ; Else return with carry not set, was ok ; ; Receive the Cyclic Redundancy Check characters (2 bytes) and see if ; the CRC received matches the one calculated. If they match, get next ; record, else send a NAK requesting the record be sent again. ; RCVCRC: MVI E,2 ; Number of bytes to receive ; RCVCRC2:MVI B,5 ; 5 second timeout CALL RECV ; Get CRC byte JC RCVSTOT ; Timeout DCR E ; Decrement the number of bytes JNZ RCVCRC2 ; Get both bytes CALL CRCCHK ; Check received CRC against calc'd CRC ORA A ; Is CRC okay? JZ CHKSNUM ; Yes, go check record numbers CALL ILPRTL ; Show locally only DB ' - CRC error',CR,LF,0 JMP RCVSR ; Go check error limit and send NAK ; ; Previous record repeated, due to the last ACK being garbaged. ACK it ; so sender will catch up ; RCVACK: CALL SNDACK ; Send the ACK JMP RCVRECD ; Get next block ; ; Send an ACK for the record ; SNDACK: MVI A,ACK ; Get 'ACK' JMP SEND ; And send it ; ; Send SOH, block number and complemented block number (3 bytes total) ; SNDHDR: LDA KFLG ; Sending 1k blocks? ORA A MVI A,STX ; If yes, send a STX rather than SOH JNZ $+5 MVI A,SOH ; Send start of header CALL SEND ; SNDHNM: LDA RCDCNT ; Send the current record number CALL SEND LDA RCDCNT ; Get the record number again CMA ; Complemented JMP SEND ; From SENDHDR ; ; Send the data record ; SNDREC: LDA CRCFLG ORA A JNZ SNDREC1 CALL CATCH ; SNDREC1:MVI C,0 ; Initialize checksum LXI H,0 ; Initialize CRC SHLD CRCVAL LDA KFLG ; Sending 1k blocks? ORA A LXI D,1024 JNZ $+6 ; If yes, skip the next line LXI D,128 LHLD RECPTR ; Get buffer address ; SENDC: MOV A,M ; Get a character CALL SEND ; Send it INX H ; Point to next character DCX D MOV A,E ORA D JNZ SENDC ; If DE not zero, keep going RET ; From SENDREC ; ; Send the CRC or checksum value, whichever appropriate ; SNDCHK: LDA CRCFLG ; See if sending 'CRC' or 'checksum' ORA A JNZ SNDCRC ; If not zero, send the 'CRC' value ; ; Send the checksum ; SNDCKS: MOV A,C ; Send the checksum JMP SEND ; From SNDCKS ; ; Send the two Cyclic Redundancy Check characters. Call FINCRC to cal- ; culate the CRC which will be in 'DE' upon return. ; SNDCRC: 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 ; ; After a record has been sent, and accepted, move the pointers forward ; 128 or 1024 characters for the next record. ; SETPTR: LXI D,128 ; For 128 character blocks LDA KFLG ; See if last block sent was 1k ORA A JZ $+6 ; If not, skip next line LXI D,1024 ; Else set for 1024 character blocks LHLD RECPTR ; Get the buffer pointer DAD D ; Increment for the record just sent SHLD RECPTR ; New buffer address for next block RET ; ; After a library transmission has been made, decrement the remaining records ; in that library file, then reset the 1k flag if less than 8 remaining. ; SETLBR: LDA KFLG LXI D,-1 ORA A JZ $+6 LXI D,-8 LHLD RCNT ; Alter the records-sent count DAD D SHLD RCNT ; One less transmission to go ORA A ; 'K' flag already zero? RZ ; If yes, skip the rest ; ; See if enough records left to use 1k protocol if requested ; SETFLG: LHLD RCNT MOV A,H ; Anything in the 'H' register? ORA A RNZ MOV A,L ; Get number of records in 'L' register CPI 8 ; At least 8 yet? RNC ; If 8 or more, keep going XRA A ; Reset the 'K' flag STA KFLG RET ; ; After a record is sent, a character is returned telling if it was re- ; ceived properly or not. An ACK allows the next record to be sent. A ; NAK causes the current record to be resent. If no character (or any ; character other than ACK or NAK) is received after a short wait (10 ; to 12 seconds), a timeout error message is shown and the record will ; be resent. ; GTACK: CALL MDINST ; See if a character is ready, now JNZ GTACK1 ; If not exit CALL MDINP ; Get the character in 'A' register CPI ACK ; See if an ACK already RZ ; If yes, return CPI NAK ; See if a NAK JZ GTACK2 ; If yes, print error, then resend CPI CANCEL ; CTL-X to cancel attempt? JZ GTCAN ; GTACK1: MVI B,1 ; 1 second for an ACK or NAK CALL RECV ; Go wait for a character JC GTACK2 ; No character, timed out CPI ACK ; Was it an ACK? RZ ; If yes, return CPI NAK JZ GTACK3 CPI CANCEL ; CTL-X to cancel attempt? JZ GTCAN ; GTACK2: MVI B,12 ; 12-seconds more for an ACK or NAK CALL RECV ; Go wait for a character JC GTATOT ; No character, timed out CPI ACK ; Was it an ACK? RZ ; If yes, return CPI 7BH ; V.22 synch character, ignore JZ GTACK2 ; If yes, ignore CPI 0FBH ; V.22 synch character, ignore JZ GTACK2 CPI CANCEL ; CTL-X to cancel attempt? JZ GTCAN ; GTACK3: MOV B,A ; Save the character LDA CHKEOT ; Sending EOT? ORA A JNZ ACKERR ; If yes, don't show error (for MB-KMD) CALL ILPRTL DB ' - ',0 MOV A,B CPI NAK JZ GTACK4 CALL HEXO CALL ILPRTL DB 'H',0 JMP GTACK5 ; GTACK4: CALL ILPRTL DB 'NAK',0 ; GTACK5: CALL ILPRTL DB ' received not ACK',CR,LF,0 ; ; Timeout or error on ACK - bump error count then resend the record if ; error limit is not exceeded ; ACKERR: LDA ACCERR ; Count accumulated errors on ACK INR A ; Add in this error STA ACCERR LDA ERRCT ; Get count INR A ; Bump it STA ERRCT ; Save back CPI 10 ; At limit? JNC ACKMSG ; If yes, send error message and abort CALL RDCOUNT ; Else show the record count for repeat STC ; Make sure carry is set for repeat RET ; And go back ; ; Reached error limit ; ACKMSG: CALL WAIT1 ; Wait for any input to stop MVI A,CANCEL ; Tell remote we are quitting CALL SEND CALL SEND CALL SEND MVI B,1 ; Wait for remote to perhaps quit too CALL RECV MVI A,BS CALL SEND ; Clear any CTL-X from buffer CALL SEND CALL SEND XRA A STA CONONL ; Show message on modem and CRT CALL ERXIT DB CR,LF DB ' ++ File transfer aborted ++','$' ; ; Timed out, with no character - set the carry bit and return ; GTATOT: CALL EOTCHK ; See if EOT has been received CALL ILPRTL DB ' ++ Timeout - no character received ++',CR,LF,0 JMP ACKERR ; ; Two or more CTL-X will cancel the file transfer ; GTCAN: MVI B,2 ; Up to two seconds for another CTL-X CALL RECV MVI A,CANCEL ; Get original character back JC GTACK3 ; If no more CTL-X, display the first CPI CANCEL ; Was it a second one? JZ ACKMSG ; If yes, abort the file transfer JMP GTACK3 ; Otherwise display the character ; ; Check the total error count vs. records sent, switch from 1k to 128 ; character transmissions if higher than operator selected value. ; GTRATIO:LDA KFLG ; Using 1k blocks? ORA A RZ ; If not, skip this routine LDA ERRCT ; See if we got any errors last record CPI 4 JNC GTRATIO1 ; If 4 or more, switch to 128 size LDA ACCERR ; See if up to minimum errors yet CPI 3 ; Had as many as three errors yet? RC ; If not, don't get excited too quickly LHLD RECDNO ; Get current record number increment LXI D,-8 ; Have not successfully sent this 1k yet DAD D ; Subtract the current increment, then XCHG ; Put in DE for now LHLD ACCERR ; Number of non-'ACK' errors in HL XCHG ; Back to normal CALL DVHLDE ; Get ratio in BC of records/hit LDA MSPEED ; Get current speed CPI 5 ; 1200 baud? MVI A,71-1 ; for 1200 bps JZ $+5 ; If 1200, skip next line MVI A,43-1 ; for 2400 bps CMP C ; Compare with actual ratio RC ; Return if less hits than allowed ; GTRATIO1: XRA A ; Else reset the system to 128 STA KFLG CALL ILPRTL DB CR,LF DB '++ Aborting 1k blocks, too many hits ++',CR,LF,0 RET ; CKABORT:CALL 0000H ORA A RZ ; CKABRT: CALL 0000H CPI CANCEL RNZ ; ; Aborts send or receive routines and returns to command line ; ABORT: LXI SP,STACK CALL WAIT1 ; 1- second delay to clear input MVI A,CANCEL ; Show you are cancelling CALL SEND ; They may quit also with enough CTL-X CALL SEND CALL SEND CALL WAIT1 ; 1-second delay to clear input MVI A,BS CALL SEND CALL SEND CALL SEND ; ABORTX: CALL CATCH LDA OPTSAV CPI 'R' JZ RCVSABT MVI A,0 STA CONONL ; Show to remote also CALL ERXIT ; Exit with abort message DB CR,LF DB ' ++ MB-KMD aborted ++','$' ; ; Check to see if an EOT has been received - if so, remote end doesn't ; wait for ACK of first EOT sent to us. ; EOTCHK: LDA EOTFLG ; Get status ORA A ; EOT received RZ ; Return if not JMP RCVEOT ; ; Increment record number ; INCRNO: PUSH H PUSH D XRA A STA EOTFLG ; Clear end of transmission flag LHLD RCDCNT ; Increment the transmission count INX H SHLD RCDCNT LXI D,1 ; Increment one record only LDA KFLG ; Sending 1k blocks? ORA A JZ INCRN1 ; If not, exit LXI D,8 ; If yes, increment count by 8 ; INCRN1: LHLD RECDNO ; Get current record count DAD D ; Increment that count properly SHLD RECDNO CALL RDCOUNT POP D POP H RET ; ; Display the record count on the local CRT if "CONOUT" was filled in by ; the implementor ; RDCOUNT:LDA OPTSAV ; See if receive or send mode CPI 'R' JZ RMSG ; Yes, else... LDA KFLG ORA A ; Ymodem download? JZ XSCNT ; No, else... CALL ILPRTL ; Show locally only DB CR DB 'Sending Ymodem packet > ',0 JMP REST ; XSCNT: CALL ILPRTL DB CR DB 'Sending Xmodem packet > ',0 JMP REST ; RMSG: LDA KFLG ORA A ; Ymodem upload? JZ XRCNT ; No, else... CALL ILPRTL ; Show locally only DB CR DB 'Received Ymodem packet > ',0 JMP REST ; XRCNT: CALL ILPRTL DB CR DB 'Received Xmodem packet > ',0 REST: LDA KFLG ORA A LHLD RECDNO JZ $+6 CALL DIVREC CALL DECOUT CALL ILPRTL DB ' ',0 CALL FUNCHK ; Check for function keys RET ; ; See if file exists - if it exists, ask for a different name. ; CHEKFIL: IF NOT (SETAREA OR ASKAREA) LDA PRVTFL ; Receiving in private area? ORA A CNZ RECAREA ; If yes, set drive and user area ENDIF ; IF SETAREA OR ASKAREA CALL RECAREA ; Set the designated area up ENDIF ; MVI C,SRCHF ; See if it LXI D,FCB ; Point to control block CALL BDOS ; Exists INR A ; Found? RZ ; No, return MVI A,CANCEL ; Tell the remote we are aborting CALL SEND ; Send several cancel requests CALL SEND CALL SEND ; CHEKF1: MVI B,1 CALL RECV JNC CHEKF1 ; Wait until no more characters LDA BCHFLG ; Using batch mode now? STA CONONL ; If not, send message to modem also ORA A JZ CHEKF2 ; If not, exit MVI A,CANCEL CALL SEND CALL SEND CALL SEND MVI A,BS CALL SEND ; CHEKF2: CALL ERXIT ; Exit, print error message DB '++ File exists, use a different name ++','$' ; ; ; =============================== ; Make the file to be received: ; =============================== ; MAKEFIL:XRA A ; Set extent and record number to 0 STA FCBEXT STA FCBRNO ; IF HIDEIT CALL WHLCHK JNZ NOTSYS ; Don't make it $SYS if SYSOP online PUSH H LXI H,FCB+10 ; point at second char of file extent MOV A,M ORI 80H ; and turn on the high bit (Make file $SYS) MOV M,A ; put it back POP H NOTSYS: ENDIF ; MVI C,MAKE ; Get BDOS FNC LXI D,FCB ; Point to FCB CALL BDOS ; To the make INR A ; 0FFH=bad? RNZ ; Open ok ; ; Directory full - can't make file ; CALL ERXIT DB '++ Can''t make file, directory full? ++','$' ; ; Computes record count, and saves it until a successful file-open. ; CNREC: MVI C,FILSIZ ; Computes file size LXI D,FCB CALL BDOS ; Read first LHLD RANDOM ; Get the file size SHLD RCNT ; Save total record count RET ; ; ; ======================= ; Open file to be sent: ; ======================= ; OPNFIL: 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 ; Open it CALL BDOS INR A ; Open ok? JNZ OPNOK ; If yes, exit LDA OPTSAV CPI 'L' ; .LBR? JZ NOLBR ; Abort, not found CPI 'A' ; .ARK/.ARC? JNZ NONAME ; Abort, no match ; ; If the file doesn't open with .ARK (default if no type specified), try .ARC ; and abort if still no good. ; LXI H,FCB+9 ; Point to type MVI M,'A' INX H MVI M,'R' INX H MVI M,'C' ; Force .ARC type LXI D,FCB ; Point to file MVI C,OPEN ; Get function CALL BDOS INR A ; Open ok? JNZ OPNOK ; Yes, continue ; NOARK: CALL ERXIT DB '++ No .ARK/.ARC file found with that name ++','$' ; NOLBR: CALL ERXIT DB '++ No .LBR file found with that name ++','$' ; NONAME: CALL ERXIT DB '++ No file with that name ++','$' ; ZEROLN: CALL ERXIT DB '++ File is empty, MB-KMD aborted ++','$' ; OPNOK: CALL WHLCHK ; Check wheel status if ZCPR JNZ OPNOK1 ; If non-zero skip all restrictions ; IF TAGFIL LDA LBRARC ORA A ; Member extraction? JNZ OPNOK0 LDA FCB+1 ; First character of file name ANI 80H ; Check bit 7 JNZ OPNOT1 ; If bit 7 is set, file is tagged LDA FCB+2 ; Also check 'F2' for a tag ANI 80H ; Is it set? JNZ OPNOT ; If yes, cannot be downloaded ENDIF ; TAGFIL ; OPNOK0: IF NOSYS LDA FCB+10 ANI 80H JNZ NONAME ; If $SYS then fake a "file not found" ENDIF ; NOSYS ; JMP OPNOK1 ; If not, ok to send file ; OPNOT: CALL ERXIT ; Exit with message DB '++ File is not for distribution, sorry ++','$' ; OPNOT1: CALL ERXIT ; Exit with message DB '++ Only individual members may be downloaded ++','$' ; OPNOK1: LDA BCHFLG ; Requesting batch mode? ORA A JNZ OPNOK2 ; If yes, skip library stuff LDA LBRARC ORA A ; Member extraction? JZ OPNOK2 ; MVI C,STDMA LXI D,TBUF CALL BDOS MVI C,READ LXI D,FCB CALL BDOS ORA A ; Read ok? JNZ RDERR ; If not, error LXI H,FCB+9 ; Get first character of filename MOV A,M ANI 7FH ; Strip high bits CPI 'A' ; ARK or ARC? JZ CKARC ; Yes, skip library stuff LHLD 8EH ; Get the file size SHLD DIRSIZ ; Store it LXI H,TBUF MOV A,M ORA A JZ CKDIR ; Check directory present? ; NOTLBR: CALL ERXIT DB '++ Corrupt library directory - please 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 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 # MVI C,RRDM ; Read random LXI D,FCB ; Point to FCB of .LBR file CALL BDOS JMP OPNOK3 ; No need to error check ; ; Come here if no file name match and another sector is needed ; NOMTCH: INX H ; Skip past the end of the file entry DCR B JNZ NOMTCH LXI B,20 ; Point to next file entry DAD B LXI D,MEMFCB ; Point to member name again MOV A,H ; See if we checked all 4 entries ORA A JZ CMLP ; No, check next LHLD DIRSIZ ; Get directory size MOV A,H ORA L JNZ INLBR ; Continue if still more to check ; NOMEMBR:CALL ERXIT DB '++ Member not found ++','$' ; INLBR: DCX H ; Decrement dirctory size SHLD DIRSIZ MVI C,READ ; Read next sector of directory LXI D,FCB CALL BDOS ORA A ; Read ok? JNZ NOTLBR ; If not, error or end of file LXI H,TBUF ; Set our pointers for compare LXI D,MEMFCB JMP CMLP ; Check next sector ; ; .ARK/.ARC file routine -- for "self-unpacking" archive files (i.e., MS-DOS ; ARC and PKARK .COM files and CP/M's NOAH in the future), up to 3 extra bytes ; are allowed before finding the ARCMaRK. ; CKARC: LXI H,TBUF ; Set pointer for compare MVI B,3 ; Allow up to 3 xtra bytes at start MVI A,ARCMRK ; CKARC1: CMP M ; Header marker found? JZ CKARC3 ; Yes, else... INR L ; Bump record pointer DCR B JNZ CKARC1 ; Loop through extra bytes allowed ; CKARC2: MOV A,M ; Get next character CPI ARCMRK ; Header marker? JNZ ARCERR ; No, report ; CKARC3: LXI D,DBUF ; Disk buffer pointer STAX D ; Store header marker INX D INR L ; Bump to next byte CZ ARCRD ; Read next record if end MVI B,HDRSIZ ; Set up counter (normal header size) MOV A,M ; Get next char (compression type 1-8) STA ARCVER ; Store it MOV C,A ; Save in C for counter CPI 1 ; Compare against vers 1 (old type) JC NOMEMBR ; EOF, report member not found JNZ CKARC4 ; >1, so skip next INR A ; 1, so bump to type 2 MVI B,HDRSIZ-4 ; Set up counter (old header size) ; CKARC4: STAX D ; Store byte INX D DCR B ; Decrement header byte counter JZ CKARC5 ; Header stored, so continue INR L ; Bump to next byte CZ ARCRD MOV A,M ; Get next header byte JMP CKARC4 ; Loop until header is stored ; CKARC5: SHLD ARCPTR ; Store current record pointer LXI H,DBUF+15 ; Get compression type DCR C ; If compression type was 1... MVI C,4 ; ...4 more bytes CZ MOVER ; ...move up to uncompressed file size LXI D,DBUF+2 ; Get next member filename LXI H,MEMFCB ; Get requested member filename MVI B,11 ; Length of filename.ext ; CKARC6: LDAX D ; Get next byte ANI 7FH ; Strip high bit JZ CKARC7 ; Fill with blanks if end of name INX D ; Bump to next byte CALL UCASE ; Ensure it's upper case CPI '.' ; Type separator? JNZ CKARC8 ; No, compare MOV A,B ; Get character count CPI 4 JC CKARC6 ; Yes, so bypass separator DCX D ; Backup to '.' ; CKARC7: MVI A,' ' ; Use blank to fill file name and/or type ; CKARC8: CMP M ; Match requested member name? JNZ ONWARD ; No, skip to next member INX H ; Bump to next byte DCR B ; One less for filename.ext length JNZ CKARC6 ; Loop until all characters are compared LXI H,DBUF+18 ; Point to MSB of size MOV A,M ORA A ; 0? JNZ ARCERR ; Abort - corrupt header? DCX H MOV D,M ; Middle two bytes of size to DE DCX H MOV E,M DCX H ; Point to LSB of size ORA M ; Test it XCHG ; Page count DAD H JC TOOBIG ; Abort, too big JP CKARC9 ; Skip next if byte count <128 INX H ; Add another record ANI 7FH ; Reduce byte count ; CKARC9: LXI D,1 ; Need one more byte ADI 30 JP CKARCA ; Skip next unless xtra 2 records needed ANI 7FH ; Last byte offset INR E ; Show one more record needed ; CKARCA: DAD D ; Total records JC TOOBIG ; Abort, too big SHLD RCNT ; Save record count SHLD ARCCNT STA ARCLST ; Save last record count -1 JMP OPNOK3 ; All done, continue with download ; ARCERR: CALL ERXIT DB ' ++ Requested member not found, or ++',CR,LF DB '++ bad .ARK/.ARC header -- inform Sysop ++','$' ; TOOBIG: CALL ERXIT DB '++ Aborted -- too large for CP/M ++','$' ; ; Read record ; ARCRD: PUSH B ; Save registers PUSH D LHLD ARCREC ; Get current record number INX H ; Bump it SHLD ARCREC ; Store next record number MVI C,READ ; Read next sector of DIR to TBUF LXI D,FCB CALL BDOS POP D ; Restore registers POP B LXI H,TBUF ; Set pointers ORA A RZ ; EOF ; ARCRD1: MOV M,H ; Fill record with 0's INR L JNZ ARCRD1 ; Loop until record filled with 0's STA ARCEOF ; Set EOF flag MVI L,TBUF ; Set pointers RET ; ; Increment to next .ARK/.ARC member ; ONWARD: LHLD DBUF+16 ; # whole pages to skip DAD H ; # records to skip LDA DBUF+15 ; # extra bytes to skip ORA A ; >128? JP ONWRD1 INX H ; Add one more record ANI 7FH ; Reuce byte count ; ONWRD1: XCHG ; Record offset to DE LHLD ARCPTR ; Set to last byte of header INR L ; Bump to next byte ADD L ; Add byte offset JP ONWRD2 ; Skip next if overflows current record MOV L,A ; Set to start of next record MOV A,D ; Check record offset ORA E JZ CKARC2 ; Still in same record, so loop JMP ONWRD3 ; Read new record ; ONWRD2: ORI 80H ; Get proper byte offset in DMA MOV L,A ; Point to next header INX D ; ONWRD3: SHLD ARCPTR ; Save buffer pointer LHLD ARCREC ; Get current record number DAD D ; Add record offset SHLD ARCREC ; Save new record number SHLD RANDOM XRA A STA 7FH ; Clear 3rd byte LXI D,FCB MVI C,RRDM ; Read random record CALL BDOS ORA A ; Ok? JNZ NOMEMBR ; No, report member not found LXI H,FCBRNO ; Current record INR M ; Bump for sequential read LHLD ARCPTR ; Get buffer pointer JMP CKARC2 ; Loop to next member (1) ; OPNOK2: CALL WHLCHK ; Check status of wheel if ZCPR JNZ OPNOK3 ; If yes, skip the # and .COM check ; IF NOLBS OR NOCOMS ; Check for send restrictions LXI H,FCB+11 MOV A,M ; Check for protect attribute ANI 7FH ; Remove CP/M 2.x attributes ENDIF ; NOLBS OR NOCOMS ; IF NOLBS ; Do not allow '#' to be sent CPI '#' ; Chk for '#' as last first JZ OPNOT ; If '#', can not send, show why ENDIF ; NOLBS ; IF NOCOMS ; Do not allow '.COM' to be sent CPI 'M' ; If not, check for '.COM' JNZ OPNOK3 ; If not, ok to send DCX H MOV A,M ; Check next character ANI 7FH ; Strip attributes CPI 'O' ; 'O'? JNZ OPNOK3 ; If not, ok to send DCX H MOV A,M ; Now check 1st character ANI 7FH ; Strip attributes CPI 'C' ; 'C' as in '.COM'? JNZ OPNOK3 ; If not, continue CALL ERXIT ; Exit with message DB '++ Can''t Send a .COM File ++','$' ENDIF ; OPNOK3: LHLD RCNT ; Get record count MOV A,H ORA L JZ ZEROLN ; Can't send 0-length files LDA MSPEED ; Get caller's current speed CPI MINKSPD ; Less than allowed for 1k packets? JC NOT1K ; Then don't show 1k packets PUSH H CALL ILPRT DB CR,LF DB 'Ymodem packets total > ',0 POP H CALL DIVREC ; Divide number of records by 8 CALL DECOUT ; Show # of kilobytes ; NOT1K: CALL ILPRT DB CR,LF DB 'Xmodem packets total > ',0 LHLD RCNT ; Get original count CALL DECOUT LDA SNDFLG ; Receiving batch mode now? ORA A RNZ ; If yes, all done CALL ILPRT DB CR,LF DB 'Disk space you need > ',0 LHLD RCNT ; Get original count CALL DIVREC CALL DECOUT CALL ILPRT DB 'k',0 ; ; Show transfer time, first for 1k blocks, then for 128-byte blocks. If ; we are at 300 bps, report both transfer times the same. (skip the 1k ; times for slower than MINKSPD bps.) ; KMDSPD: LDA MSPEED CPI MINKSPD ; See if we are below the minimum 1k speed JC XMDSPD ; Skip 1k display if so CALL ILPRT DB CR,LF DB 'Ymodem time / 1k packets > ',0 ; LDA MSPEED CPI 5 ; Are we less than 1200 bps? JC XMSPD0 ; show Ymodem transfer time CALL KTIM ; Get file transfer time in BC (minutes) CALL STORTIM ; Store for comparing time remaining CALL OPNOK4 JMP XMDSPD ; XMSPD0: LXI H,XECTBL ; 128 size values (300 bps) SHLD RECTBL+1 CALL XTIM ; Xmodem transfer time CALL STORTIM CALL OPNOK4 ; XMDSPD: CALL ILPRT DB CR,LF DB 'Xmodem time / 128-byte packets > ',0 LXI H,XECTBL ; Use 128 size values SHLD RECTBL+1 CALL XTIM ; Get file transfer time in BC (minutes) LDA KFLG ; If 'SK' set, 1k time already stored ORA A JNZ $+6 CALL STORTIM CALL OPNOK4 LXI H,KECTBL ; Restore to original 1k values SHLD RECTBL+1 CALL ILPRT DB CR,LF,0 LDA BCHFLG ORA A CNZ CUMSTS ; Show how many files remain after this LDA FSTFLG ORA A RNZ ; LDA OPTSAV CPI 'A' JNZ SKPARC ; ; If sending an ARC or ARK file, tell user to rename to .ARK or .ARC file type. ; CALL ILPRTB DB CR,LF DB 'You MUST receive filename > ',0 MVI D,8 ; Filename count - ignore filetype LXI H,MEMFCB ; Get requested member name ; RENARC: MOV A,M CPI ' ' ; Short filename? JZ RENAR1 ; If so, fill in type CALL TYPE DCR D ; One less... INX H ; Next character JNZ RENARC ; Loop until done ; RENAR1: LDA FCBEXT-1 ; Get last character of parent filetype STA RENAR2 ; Stuff it below to display CALL ILPRTB DB '.AR' ; Same no matter what RENAR2: DW 0 ; Will be either a 'K' or a 'C' CALL ILPRTB DB CR,LF ; SKPARC: CALL ILPRTB DB CR,LF DB 'Your selection ready to Download',CR,LF DB 'To abort: CTRL-X [pause] CTRL-X',CR,LF,0 CALL ILPRTL DB LF DB ' [ waiting ]',CR,0 RET ; OPNOK4: PUSH H ; Save seconds in 'L' ; CALL WHLCHK ; Check wheel status if ZCPR JNZ SKPTIM ; If its not then skip the limit ; 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 ENDIF ; TIMEON ; 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 ; SKPTIM: MOV L,C MOV H,B CALL DECOUT ; Print decimal number of minutes CALL ILPRT DB ':',0 POP H ; Get seconds CALL ZERO ; See if 10 or more seconds 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 LDA MSPEED ; 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 LDA MSPEED CPI 5 JC OPNOK5 ; Adds a zero for 2400, 4800, 9600 bps CALL ILPRT DB '0',0 ; OPNOK5: CALL ILPRT DB ' bps',0 ; OPNOK6: LDA SNDFLG ; Receiving BATCH mode now? ORA A JNZ SKIPEM ; If yes, all done here. ; IF MAXTIM CALL WHLCHK JNZ SKIPEM ; Yes, no time limits ENDIF ; IF MAXTIM AND (BYEBDOS OR (MTOS AND MBMXT)) 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 MXTL AND MTOS AND MBMXT CALL GETTOS ; Get time on system in HL ENDIF ; IF MAXTIM AND (BYEBDOS OR (MTOS AND MBMXT)) LDA MAXTOS INR A ENDIF ; IF MXTL AND MTOS AND MBMXT SUB L ; Get how much time is left ADI MAXMIN ; Give them MAXMIN extra ENDIF ; IF MAXTIM AND (BYEBDOS OR (MTOS AND MBMXT)) 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 (MTOS AND MBMXT)) 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: RET ; IF MAXTIM OVERTM: CALL ILPRTB DB CR,LF,LF DB ' ++ MB-KMD aborted ++',CR,LF,LF DB 'Required send time exceeds the ',0 ENDIF ; IF MAXTIM AND NOT (BYEBDOS OR (MTOS AND MBMXT)) LXI H,0 LDA TON MOV B,A MVI A,MAXMIN SUB B MOV L,A ENDIF ; IF MXTL AND MTOS AND MBMXT AND (NOT BYEBDOS) CALL GETTOS ; Get TOS back into HL ENDIF ; IF MAXTIM AND BYEBDOS LDA TLOS ENDIF ; IF MAXTIM AND MTOS AND MBMXT AND (NOT BYEBDOS) LDA MAXTOS ENDIF ; IF MXTL AND MTOS AND MBMXT AND (NOT BYEBDOS) SUB L ; Get time left ADI MAXMIN ; Add MAXMIN ENDIF ; IF MAXTIM AND (BYEBDOS OR (MTOS AND MBMXT)) MVI H,0 MOV L,A ENDIF ; IF MAXTIM CALL DECOUT CALL ERXIT1 DB ' minutes allowed','$' ENDIF ; ; XTABLE: DW 5,13,19,25,30,48,85,141,210,280,0 KTABLE: DW 5,14,21,27,32,53,101,190,330,525,0 XECTBL: DB 192,74,51,38,32,20,11,8,5,3,0 KECTBL: DB 192,69,46,36,30,18,10,5,3,2,0 ; 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 'L', also stuffs the # of mins/secs values in ; PGSIZE, if LOGCAL is YES. ; KTIM: LXI H,KTABLE JMP FILTIM ; XTIM: LXI H,XTABLE ; Point to baud factor table ; FILTIM: LDA MSPEED ; Get speed indicator MVI D,0 MOV E,A ; Set up for table access DAD D ; Index to proper factor DAD D MOV E,M INX H MOV D,M LHLD RCNT ; Get number of records ; FILTIM1:CALL DVHLDE ; Divide HL by value in DE (records/min) PUSH H ; Save remainder ; RECTBL: LXI H,KECTBL ; Point to divisors for seconds calc. MVI D,0 LDA MSPEED ; 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) MOV A,L CPI 60 JC RECTB1 SUI 60 MOV L,A INR C ; RECTB1: MOV A,C ; See if any minutes ORA B RNZ ; If yes, exit MOV A,L ; See if any seconds ORA A RNZ ; If yes, exit INR A ; Else show at least one second MOV L,A RET ; STORTIM: 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 ; ; This routine divides the total number of 1024-byte blocks by 8. ; DIVREC: LXI D,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 $+4 ; If 0 remainder, exact k INX H ; Else bump up 1 k RET ; ; 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 value in 'HL' by 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 ; ZERO: MOV A,L ; Get the number of seconds CPI 9+1 ; 10 seconds or more? RNC ; If yes, disregard CALL ILPRTB DB '0',0 RET ; ; ; ========================== ; Close the received file: ; ========================== ; CLOSFIL:MVI C,CLOSE ; Get function LXI D,FCB ; Point to file CALL BDOS ; Close it INR A ; Close ok? RNZ ; Yes, return CALL ERXIT ; No, abort DB '++ Can''t close file or none received ++','$' ; ; Decimal output routine - call with binary 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 ; ; Prints a hex value in 'A' on the CRT ; HEXO: PUSH PSW RAR RAR RAR RAR CALL NIBBL POP PSW ; NIBBL: ANI 0FH CPI 10 JC ISNUM ADI 7 ; ISNUM: ADI '0' ; Add in ASCII bias JMP CTYPE ; ; Move (HL) to (DE), length in (B) ; MOVE: MOV A,M ; Get a byte STAX D ; Put at new home INX D ; Bump pointers INX H DCR B ; Decrement byte count JNZ MOVE ; If more, do it RET ; If not, return ; ; ; Read a record, refill buffer if empty ; Update record read ; RDRECD: LDA RECNBF ; See how many records in the buffer ORA A JZ RDBLOCK ; If none, go get some LDA KFLG ; Using 1k blocks? ORA A JZ RDREC1 ; If not, exit ; ; Using 1k blocks, switch to 128 if less than 8 records left ; LDA RECNBF ; See how many records in buffer CPI 8 JNC RDREC2 ; If 8 or more stay in 1k blocks XRA A ; Else there are 1-7 records left STA KFLG ; Reset the 1k flag for 128 ; RDREC1: LDA RECNBF ; Get number of records in buffer DCR A ; Decrement it for 128 character blocks STA RECNBF ; Store the new value RET ; From 'READRED' ; ; Using 1k blocks, get set to send another one ; RDREC2: SUI 8 ; Subtract 1k worth STA RECNBF RET ; ; Buffer is empty - read in another block of 16k ; RDBLOCK:LDA EOFLG ; Get 'EOF' flag CPI 1 ; Is it set? STC ; To show 'EOF' RZ ; Got 'EOF' CALL RDBLK1 JMP RDRECD ; Pass record to caller ; ; Read up to 16k from the disk file into the buffer, ready to send ; RDBLK1: MVI C,0 ; Records in block LXI D,DBUF ; To disk buffer ; RDRECLP:PUSH B PUSH D LDA OPTSAV CPI 'A' ; ARK/ARC member extraction? JZ RDARC ; If so, skip rest MVI C,STDMA ; Set DMA address CALL BDOS MVI C,READ LXI D,FCB CALL BDOS ; RDBLK2: POP D POP B ORA A ; Read ok? JNZ REOF ; If not, error or end of file 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? JNZ RDRECLP ; Read more ; ; Buffer is full or got EOF ; RDBFULL:STA RECNBF ; Store record count LXI H,DBUF ; Get the beginning buffer address SHLD RECPTR ; Save for next record MVI C,STDMA LXI D,TBUF ; Reset DMA address to default JMP BDOS ; from CALL RDBLK1 ; REOF: DCR A ; 'EOF'? JNZ RDERR ; Got 'EOF' MVI A,1 STA EOFLG ; Set EOF flag MOV A,C JMP RDBFULL ; ; .ARK/.ARC read file routine ; RDARC: LXI B,32768 ; B=128 C=0 LHLD ARCCNT ; Get record count DCX H ; Bump down one SHLD ARCCNT ; Save new count MOV A,H ORA L ; Last record? JNZ RDARC1 ; No, skip next LDA ARCLST ; Get # bytes -1 in last record MOV C,B MOV B,A ORA A JZ RDARC3 XRA C MOV C,A ; RDARC1: LHLD ARCPTR ; Get record pointer LDA ARCFST ORA A ; First record? JNZ RDARC2 ; No, skip next LXI D,DBUF+29 ; Skip header MOV A,B SUI 29 MOV B,A STA ARCFST ; Show not first time ; RDARC2: INR L ; Next byte CZ ARCRD ; Fill buffer if end MOV A,M ; Get byte STAX D INX D DCR B JNZ RDARC2 ; Loop until all bytes moved SHLD ARCPTR ; Save new pointer XRA A ; Clear all CMP C JZ RDARC4 ; Skip next ; RDARC3: STAX D ; Store EOF in buffer INX D INR C JNZ RDARC3 ; Loop to zero final record ; RDARC4: LDA ARCEOF ; Get flag status JMP RDBLK2 ; Return for more ; ; Read error ; RDERR: CALL ERXIT DB '++ File read error ++','$' ; ; end of read record routine ; ========================== ; ; Writes the record into a buffer. If/when 16k has been written, writes ; the block to disk. ; ; Entry point "WRBLOCK" flushes the buffer at EOF ; WRRECD: LHLD RECPTR ; Get buffer address LXI D,128 ; 128 chars/record LDA KFLG ; Using 1k blocks? ORA A JZ $+6 ; If not, skip next line LXI D,1024 ; 1k/record DAD D ; To next buffer SHLD RECPTR ; Save buffer address LDA KFLG ; Using 1k blocks? ORA A JZ WRREC1 ; If not, exit LDA RECNBF ; Get number of records in buffer ADI 8 ; Increment it 8 records for 1k JMP WRREC2 ; WRREC1: LDA RECNBF ; Get number of records in buffer INR A ; increment it for 1 record ; WRREC2: STA RECNBF ; Store the new value CPI BUFSIZ*8 ; Is the buffer full, yet? RNZ ; 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,STDMA ; 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: MVI C,STDMA LXI D,TBUF ; Reset DMA address JMP BDOS ; WRERR: CALL RSDMA ; Reset DMA to normal MVI C,CANCEL ; Cancel CALL SEND ; Sender CALL SEND CALL SEND CALL RCVSABT ; Kill receive file CALL ERXIT ; Exit with msg: DB '++ Error writing file ++','$' ; ; Receive a character - timeout time is in 'B' in seconds. Entry via ; 'RCVDG' 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. ; RECV: PUSH D ; Save 'DE' regs. MVI E,MHZ ; Get the clock speed XRA A ; Clear the 'A' reg. ; MSLOOP: ADD B ; Number of seconds DCR E ; One less mhz. to go JNZ MSLOOP ; If not zero, continue MOV B,A ; Put total value back into 'B' ; MSEC: IF NOT BYEBDOS LXI D,6600 ; 1 second DCR loop count ENDIF ; IF BYEBDOS LXI D,2800 ; (includes BYEBDOS overhead) ENDIF ; MWTI: CALL MDINST ; Input from modem ready JZ MCHAR ; Yes, get 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 MDCARCK ; 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 MDINP ; 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 MDCARCK ; 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 ; ; Report to local console ; CALL ILPRTL ; Report loss of carrier DB CR DB ' ++ Carrier lost in MB-KMD ++',CR,LF,0 ; CARCK2: LDA OPTSAV ; Get option CPI 'R' ; If not receive JNZ EXIT ; Then abort now, else CALL DELFILE ; Delete the file we started JMP EXIT ; From CARCK back to CP/M prompt ; ; Delay - 100 millisecond delay. ; DELAY: PUSH B ; Save 'BC' LXI B,MHZ*4167 ; Value for 100 ms. delay ; DELAY2: DCX B ; Update count MOV A,B ; Get MSP byte ORA C ; Count = zero? JNZ DELAY2 ; If not, continue POP B ; Restore 'BC' RET ; Return to CARCK1 ; ; Delay to let all incoming stop for one second ; WAIT1: MVI B,1 ; For 1-second CALL RECV ; See if any characters still coming in JNC WAIT1 ; If yes, keep looping RET ; If none for 1-second, all done ; ; ; ============================== ; Upload Description Routines: ; ============================== ; ASK: IF DESCRIB OR MSGDESC LDA OPTSAV ; Get the option CPI 'R' ; Are we in Receive mode? RNZ ; No, exit LDA PRVTFL ; Yes, is it Private? ORA A RNZ ; Yes, do not ask for description ENDIF ; IF (DESCRIB OR MSGDESC) AND (ACCESS AND PUPOPT) LDA PUPFLG ; Get privileged status ORA A ; Privileged transfer request? RNZ ; Yes, skip description ENDIF ; IF MSGDESC AND (NOT DESCRIB) MVI A,1 STA DSCFLG ; Set flag to show message base descrips ENDIF ; IF DESCRIB OR MSGDESC LDA FILCNT ; Any batch files received? ORA A JZ ASK1 ; If not, exit LXI H,NAMBUF SHLD NBSAVE CALL BCHDCR ; If yes get the filname ENDIF ; ASK1: IF DESCRIB AND ASKIND AND (NOT MSGDESC) LDA SAVTYP ; Do we have a category yet? CPI 0 JNZ KNOTYP ; Yes, skip this CALL DELAY CALL SHONM ; Show the file name CALL DILPRT DB ' - this file is for:',CR,LF,LF,0 CALL GETKIND ; Get file category for description header CALL TYPE ; Output to both consoles ; KNOTYP: STA KIND ENDIF ; ASK2: IF WRAPOPT AND (DESCRIB OR MSGDESC) LDA CHKASK ORA A ; Already been here? JNZ ASK3 ; Yes, so skip the rest MVI A,1 STA CHKASK ; Show we've been here now CALL DILPRT DB CR,LF,LF DB 'If you have pre-typed your description(s) and wish' DB ' to turn off wrap',CR,LF DB 'during each description text transfer, answer es.',CR,LF,LF DB 'Turn off automatic end-of-line wrap? ',BS,BS,0 ; CALL INPUT CALL UCASE ; Change to upper case CALL DILPRT DB 'Wrap ',0 CPI 'Y' ; Turn off wrap mode? JNZ ASK2A ; No CALL DILPRT ; ...else DB 'OFF>',CR,LF,0 MVI A,72 STA XWRAP ; Turn off wrap mode JMP ASK3 ; Ask for description ; ASK2A: CALL DILPRT DB 'ON>',CR,LF,0 ENDIF ; ASK3: IF DESCRIB OR MSGDESC CALL DILPRT DB CR,LF,LF DB 'Please describe this file in 7 lines or less. Tell ' DB 'what equipment it is',CR,LF DB 'for and what the program does. Hit an extra CR ' DB 'on a blank line when done.',CR,LF,LF,0 LXI H,HLINE ; Get the file name from FCB, skip any blanks ENDIF ; IF MSGDESC AND (NOT DESCRIB) CALL DSTOR2 ; Store 'Msg#: ????' and 'From: ' LDA UPDRV ; Get upload drive area CALL OUTCHR ; Store it LDA UPUSR ; Get upload user area CALL DATDEC ; Convert and store MVI A,':' ; Add a ':' to seperate from filename CALL OUTCHR ; Store it ENDIF ; IF DESCRIB AND (NOT MSGDESC) CALL DSTOR1 ; Store filename (and category if ASKIND) ENDIF ; IF DESCRIB OR MSGDESC CALL CLRBUF ; Clear OLINE to 80 spaces MVI B,8 ; Get filename LXI D,FCB+1 LXI H,OLINE ; Point to destination CALL LOPFCB ; Write filename to memory ENDIF ; IF DESCRIB AND (NOT MSGDESC) LDAX D CPI ' ' ; Any file extent? JZ AFIND1 ; If not, skip the period and extent ENDIF ; IF DESCRIB OR MSGDESC MVI A,'.' MOV M,A ; Separate FILENAME and EXTENT CALL TYPE INX H MVI B,3 ; Get EXTENT name CALL LOPFCB ENDIF ; AFIND1: IF (DESCRIB AND ASKIND) OR (ASKAREA AND (NOT SETAREA)) LDA KIND ; Now, compare the ASCII byte in KIND to get CPI 'A' ; the file category. In case it matches, LXI D,KINDA+4 ; we point the DE register at the table CZ DKIND ; description, past the 'A)'. If it CPI 'B' ; matches, put it in description header. LXI D,KINDB+4 ; Step thru table looking for a match. CZ DKIND CPI 'C' LXI D,KINDC+4 CZ DKIND CPI 'D' LXI D,KINDD+4 CZ DKIND CPI 'E' LXI D,KINDE+4 CZ DKIND CPI 'F' LXI D,KINDF+4 CZ DKIND CPI 'G' LXI D,KINDG+4 CZ DKIND CPI 'H' LXI D,KINDH+4 CZ DKIND CPI 'I' LXI D,KINDI+4 CZ DKIND CPI 'J' LXI D,KINDJ+4 CZ DKIND CPI 'K' LXI D,KINDK+4 CZ DKIND CPI 'L' LXI D,KINDL+4 CZ DKIND CPI 'M' LXI D,KINDM+4 CZ DKIND CPI 'N' LXI D,KINDN+4 CZ DKIND CPI 'O' LXI D,KINDO+4 CZ DKIND CPI 'P' LXI D,KINDP+4 CZ DKIND CPI 'Q' LXI D,KINDQ+4 CZ DKIND CPI 'R' LXI D,KINDR+4 CZ DKIND CPI 'S' LXI D,KINDS+4 CZ DKIND CPI 'T' LXI D,KINDT+4 CZ DKIND CPI 'U' LXI D,KINDU+4 CZ DKIND CPI 'V' LXI D,KINDV+4 CZ DKIND CPI 'W' LXI D,KINDW+4 CZ DKIND CPI 'X' LXI D,KINDX+4 CZ DKIND CPI 'Y' LXI D,KINDY+4 CZ DKIND CPI 'Z' LXI D,KINDZ+4 CZ DKIND ENDIF ; IF ASKAREA AND (NOT SETAREA) LDA FRMSPC ; See if we are here from SPACE: routines ORA A RNZ ; If we are, return to SPC??: ENDIF ; IF MSGDESC AND (NOT DESCRIB) LXI D,HLINE3 CALL DKIND JMP GETDSC ENDIF ; IF DESCRIB AND ASKIND AND (INCLDU OR (CLOCK AND DSTAMP)) AND (NOT MSGDESC) DCX H MVI A,' ' ; Cover over the CR/LF in the line with spaces MOV M,A INX H MOV M,A ENDIF ; ; If INCLDU is set YES, this routine will include the drive/user area of the ; uploaded file into the description header. Saves time editing the file ; descriptors at KIND?: ; IF DESCRIB AND INCLDU AND (NOT MSGDESC) LXI H,OLINE+40 MVI A,'(' ; Let's start by entering an open parentheses MOV M,A ; Into the memory buffer INX H ; Increment pointer LDA UPDRV ; Drive upload received on MOV M,A ; Into memory INX H ; Increment pointer LDA UPUSR ; User area upload received on (in binary) CALL DATDEC ; Convert binary number to decimal and store MVI A,':' ; We now have our drive/user in place MOV M,A ; Add a colon ':' into memory INX H ; Increment pointer MVI A,')' ; ')' into 'A' MOV M,A ; Now into memory INX H ; Increment pointer ENDIF ; ; If DSTAMP is YES, this routine will place the date the file was uploaded ; into the upload description header. (CLOCK must also be YES). ; IF DESCRIB AND CLOCK AND DSTAMP AND (NOT MSGDESC) PUSH D ; Put 'Rcvd: ' message into memory buffer LXI H,OLINE+52 ; Aim HL so Rcvd: lands in the same column LXI D,DATMSG ; each time. Offset (52), changed if desired. ; DATPT1: LDAX D ; 'D' into 'A' CPI 0 ; Are we done? JZ DATPT2 ; Yes, fill in date MOV M,A ; No, move character into memory INX H ; Increment pointer INX D JMP DATPT1 ; Keep looping until done ; DATPT2: POP D PUSH H ; Save HL in case using BDOS 79 (BYEBDOS) CALL GETDATE ; Get current date POP H PUSH B ; (save DD/YY) CALL DATDEC ; Print MM to memory MVI A,'/' ; '/' MOV M,A INX H POP PSW ; Get DD/YY PUSH PSW ; Save YY CALL DATDEC ; Print DD MVI A,'/' ; '/' MOV M,A INX H POP B ; Get YY MOV A,C CALL DATDEC ; Print YY ENDIF ; IF DESCRIB AND (INCLDU OR (DSTAMP AND CLOCK)) AND (NOT MSGDESC) MVI M,CR ; We took the CR,LF off to include either INX H ; the DSTAMP and/or INCLDU, now we have to MVI M,LF ; put them back on. CALL DILPRT ; And output to both consoles DB CR,LF,0 ENDIF ; IF DESCRIB OR MSGDESC GETDSC: CALL DSTOR ; Put filename line into memory and show CALL DILPRT DB CR,LF DB ' <----------------------( maximum ' DB 'line length )----------------------->',CR,LF,0 XRA A STA ANYET ; Reset the flag for no information yet ENDIF ; IF MSGDESC AND (NOT DESCRIB) LXI H,HLINE2 ; Add a blank line for MFMSG formatting CALL DSTOR1 ENDIF ; IF DESCRIB OR MSGDESC MVI C,'0' ; Initialize line counter to 0 EXPLN: INR C ; Add one MOV A,C CPI '7'+1 ; 8 or more? JNC EXPL1 ; Yep, get out of here CPI '6'+1 ; On line 6? JC EXPL0 CALL DILPRT ; One line left, tell him DB 'Last Line',CR,LF,0 MOV A,C ; Get line count again ; EXPL0: CALL TYPE ; Nope, print line number MVI A,' ' ; Stuff spaces for FOR format CALL OUTCHR CALL OUTCHR CALL OUTCHR CALL DILPRT DB '> ',0 CALL DESC ; Get a line of information CALL DSTOR JMP EXPLN ; EXPL1: LXI H,HLINE3 ; All finished, put in an extra CR-LF CALL DSTOR2 CALL DILPRT DB CR,LF DB 'Here''s what you wrote:',CR,LF,LF,0 LHLD BUFADR ; Get starting address of description XCHG ENDIF ; IF MSGDESC AND (NOT DESCRIB) MVI B,5 ; EXPL1A: LDAX D INX D CPI LF ; Line feed? JNZ EXPL1A ; No, continue looking DCR B ; Yes, count 5 of them before printing JNZ EXPL1A ; Do it again if not to 0 CALL SHONM ; Show the filename CALL DILPRT DB CR,LF,LF,0 ENDIF ; IF DESCRIB OR MSGDESC MVI C,PRINT CALL BDOS LHLD OUTPTR DCX H SHLD OUTPTR ; EXPL2: CALL DILPRT DB 'Is this correct? (Y/N) ',0 CALL INPUT CALL UCASE ; Change to upper case CALL TYPE ; Display answer CPI 'Y' ; Is this description ok? JZ EXPL4 ; Yes, so see if there are more CPI 'N' JNZ EXPL2 ; EXPL3: LHLD BCHPTR ; Else restart at beginning of text SHLD OUTPTR ; Start over at this address JMP ASK1 ; Go do this one again ; ; See if any more batch files need descriptions ; EXPL4: LXI H,FCB ; Zero the FCB area for next file CALL INITFCB1 LDA FILCNT ; Any more file names left in buffer? ORA A JZ EXPL5 ; If not, all finished LHLD BCHADR ; Get the current output address SHLD BUFADR ; Store for next verify LHLD OUTPTR ; Get end of current description SHLD BCHPTR ; Store for start of next one JMP ASK1-3 ; Get the next file description ; ; Now open the file and put this at the beginning ; EXPL5: LDA 0004H ; Get current drive/user STA DRUSER ; Store MVI C,SETUSR ; Set drive/user to the area listed above ENDIF ; IF DESCRIB AND (NOT MSGDESC) MVI E,USER ; Set user to FOR file user area CALL BDOS MVI A,DRIVE ; Set drive to FOR file drive ENDIF ; IF MSGDESC AND (NOT DESCRIB) MVI E,PRUSR CALL BDOS ; Set private upload user for msg descrips MVI A,PRDRV ENDIF ; IF DESCRIB OR MSGDESC SUI 41H MOV E,A MVI C,SELDSK CALL BDOS ; Set private upload drive for msg descrips ; ; Open source file ; LXI D,FILE ; Open FOR text file MVI C,OPEN CALL BDOS ENDIF ; IF DESCRIB AND (NOT MSGDESC) INR A ; Check for no open JNZ OFILE ; File exists, exit ENDIF ; IF DESCRIB OR MSGDESC 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 with that name LXI D,DEST CALL BDOS MVI C,MAKE ; Now make a new file with that name LXI D,DEST CALL BDOS INR A JZ NOROOM ; Cannot open file, no directory room ENDIF ; IF DESCRIB AND (NOT MSGDESC) CALL DILPRT DB CR DB 'Writing description to file...',CR,LF,0 ENDIF ; IF MSGDESC AND (NOT DESCRIB) CALL DILPRT DB CR DB 'Please stand by... ',CR,LF,0 ENDIF ; ; Read sector from source file ; IF DESCRIB OR MSGDESC READLP: MVI C,STDMA LXI D,TBUF CALL BDOS MVI C,READ LXI D,FILE ; Read from FOR text file 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 SENDBEL ; 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: JMP TYPE ; Write to the "CRT", done ; ; 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 CPI ' ' JZ DESC3B ; DESC3A: MOV A,B CPI 71 ; Do not exceed line length JC DESC1 CALL SENDBEL ; Send a bell to the modem CALL BCKSP2 CALL BCKSP1 ; Do not allow a too-long line JMP DESC1 ; DESC3B: LDA XWRAP CMP B ; Time for next line? JNC DESC3A ; No JMP DESC5 ; ...else get it ; DESC4: LDA ANYET ; Any text typed on first line yet? ORA A JNZ DESC5 ; If yes, exit POP H JMP EXPL3 ; 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? ADI 8 CPI 71 JC DESC7 ; No, so do TAB function JMP DESC5 ; ...else start a new line ; DESC7: MVI M,' ' MOV A,M CALL TYPE INX H INR B MOV A,B ANI 7 JNZ DESC7 JMP DESC1 ; Ask for next character ; ; Print message then exit to CP/M ; DEXIT: POP D ; Get message address MVI C,PRINT ; Print message CALL BDOS JMP RESET ; Reset the drive/user, then finished ; DILPRT: XTHL ; Save HL, get message address ; DILPLP: MOV A,M ; Get character INX H ; Next character in the string ORA A JZ DILPL1 CALL TYPE ; Output it JMP DILPLP ; DILPL1: XTHL ; Restore HL, return address RET ENDIF ; IF (DESCRIB AND ASKIND) OR (ASKAREA AND (NOT SETAREA)) OR MSGDESC DKIND: LDAX D ; Get the character from the string ENDIF ; IF ASKAREA AND (NOT SETAREA) PUSH A ; Save 'A' LDA FRMSPC ; Are we here from the SPACE: routines? ORA A JZ DKINDD ; No, so skip all this LDA NODASH ; Have we ignored a '-' yet? ORA A JNZ DKINDA ; Yes, we display the rest INR A STA NODASH ; Show we've skipped the first dash INX D ; Skip first space INX D ; And the dash INX D ; And one more space, now on first character POP A JMP DKIND ; Get first character of category in 'A' ; DKINDA: POP A CPI CR ; Is it a 'CR'? RZ ; Yes, we're done. Return to SPACE: routines CPI ' ' ; Is it a ' '? (Don't display trailing ' ') JNZ DKINDC ; No, display it PUSH A PUSH D INX D ; Increment 'DE' LDAX D ; Next character into 'A' CPI ' ' ; Is it a space? JNZ DKINDB ; No, not two in a row, print first space POP D ; Restore 'D' POP A ; and 'A' RET ; 2 spaces, we're done ; DKINDB: POP D POP A DKINDC: CALL UCASE ; Make sure character is in uppercase CALL TYPE ; Output it to both remote and local INX D ; Increment character pointer JMP DKIND ; Get next character into 'A' ; DKINDD: POP A ENDIF ; IF DESCRIB AND ASKIND AND CLOCK AND DSTAMP AND (NOT MSGDESC) CPI CR ; Is it a 'CR'? JZ DKIND0 ; Yes, don't display it, but put in buffer CPI LF ; No, is it a 'LF'? JZ DKIND0 ; Yes, don't display it, but put in buffer ENDIF ; IF (DESCRIB AND ASKIND) OR MSGDESC CALL TYPE ; Otherwise display the character ; DKIND0: MOV M,A ; Put in the buffer CPI LF ; Done yet? ENDIF ; IF MSGDESC AND (NOT DESCRIB) RZ ENDIF ; IF DESCRIB AND ASKIND AND (NOT MSGDESC) JZ DKIND1 ; Exit if a LF, done ENDIF ; IF (DESCRIB AND ASKIND) OR MSGDESC 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 DESCRIB OR MSGDESC DSTOR: LXI H,OLINE ; DSTOR1: MOV A,M CALL OUTCHR CPI LF RZ INX H JMP DSTOR1 ; DSTOR2: MOV A,M ; Get next character ORA A ; Any? RZ ; Nope, return CALL OUTCHR ; Yep, transfer it to buffer INX H ; Increment to next character JMP DSTOR2 ; Loop until done ; ; Disk is full, save original file, erase others. ; FULL: MVI C,DELET LXI D,DEST CALL BDOS JMP DEXIT DB '++ Disk Full, aborting, saving original file ++','$' ; ; Stores the Filename/extent in the buffer temporarily ; LOPFCB: LDAX D ; Get FCB FILENAME/EXT character ANI 7FH ; Strip 7th bit in case we made $SYS file CPI ' '+1 ; Skip any blanks 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 '++ No directory space: Output ++','$' ; ; Output error - cannot close destination file ; OERROR: JMP DEXIT DB '++ Can''t close file: Output ++','$' ; ; 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,STDMA ; CALL BDOS MVI C,WRITE LXI D,DEST 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: MVI C,STDMA LXI D,TBUF 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 XCHG SHLD BCHADR 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 ++','$' ENDIF ; ; Reset the Drive/User to original ; RESET: IF MSGDESC AND (NOT DESCRIB) LDA DSCFLG ORA A ; Entering an upload description? JZ RESET1 ; No, so get out of here MVI C,CURDRV ; Get current drive of 'FOR' file CALL BDOS STA DSKSAV MVI C,SETUSR MVI E,0FFH CALL BDOS STA USRSAV ; Save for MFMSG RESET1: ENDIF ; IF MSGDESC OR DESCRIB LDA DRUSER ; Get original drive/user area back RAR RAR RAR RAR ANI 0FH ; Just look at the user area MVI C,SETUSR ; Restore original user area MOV E,A CALL BDOS LDA DRUSER ; Get the original drive/user back ANI 0FH ; Just look at the drive for now MVI C,SELDSK ; Restore original drive MOV E,A CALL BDOS CALL DILPRT ; Print CRLF before quitting DB CR,LF,0 RET ; ; Shows the Filename/extent ; SHONM: CALL DILPRT DB CR,LF,0 LXI H,FCB+1 MVI B,8 ; Maximum size of file name CALL SHONM1 MOV A,M ; Get the next character ANI 7FH ; Strip 7th bit in case $SYS file 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 ANI 7FH ; Strip 7th bit in case $SYS file 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 FOR text file LXI D,FILE CALL BDOS MVI C,CLOSE ; Close FOR.$$$ text 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 FOR text file LXI D,FILE CALL BDOS MVI C,RENAME LXI D,DEST ; Rename FOR.$$$ to FOR text file CALL BDOS JMP RESET ; Reset the drive/user, finished ENDIF ; ; Send character in 'A' register to console ; IF DESCRIB OR MSGDESC OR (ASKAREA AND (NOT SETAREA)) TYPE: PUSH B PUSH D PUSH H PUSH PSW MVI C,WRCON ; Write to console MOV E,A ; Character to 'E' for CP/M CALL BDOS POP PSW POP H POP D POP B RET ENDIF ; ; ; This fills OLINE with spaces, if using INCLDU and/or DSTAMP - keeps screen ; 'pretty'. Called if MSGDESC, but simply returns. ; CLRBUF: IF DESCRIB AND (INCLDU OR (DSTAMP AND CLOCK)) AND (NOT MSGDESC) PUSH B PUSH D PUSH H LXI H,OLINE MVI B,80 ; CLRBUF0:MVI A,' ' MOV M,A INX H DCR B JNZ CLRBUF0 POP H POP D POP B ENDIF ; RET ; ; ; Takes value in 'A', writes to 'M', 'M'+1 as ASCII 2-digit decimal string. ; This routine does not supress leading zeros. ; IF MSGDESC OR (DESCRIB AND (INCLDU OR (DSTAMP AND CLOCK))) DATDEC: PUSH B ; takes val in A, write to M, M+1 as ASCII PUSH D ; 2-digit decimal string. MOV B,A ; Save # in B MVI C,0 ; zero C ; DTENS: SUI 10 JC GTENS INR C ; count the tens in C JMP DTENS ; GTENS: ADI 10 ; recover units from before carry MOV B,A ; save units in B MOV A,C ; number of tens ADI '0' ; plus ascii offset ; GTNS: PUSH A LDA DSCFLG ; See if we are here from MSGDESC routines ORA A JZ GTNS0 ; No, put in memory and increment pointer POP A ; Restore 'A' CALL OUTCHR ; Output to FOR. file buffer JMP GTNS1 ; Skip next 3 lines ; GTNS0: POP A ; Restore 'A' MOV M,A ; Character in 'A' into memory INX H ; Point to next position in memory buffer ; GTNS1: MOV A,B ADI '0' PUSH A LDA DSCFLG ; Here from MSGDESC routines? ORA A JZ GTNS2 ; No, skip all this POP A CALL OUTCHR ; Yes, output to FOR. file buffer JMP GTNS3 ; Skip next 3 lines ; GTNS2: POP A MOV M,A INX H ; point at next open byte in buffer ; GTNS3: POP D POP B RET ENDIF ; ; ; Ask file type for uploads, configure KINDA: and TYPTBL: at front of ; program code if this is enabled. ; FILTYP: IF ASKAREA AND (NOT SETAREA) CALL ILPRTB ; Modify message as needed DB CR,LF,LF DB 'Route upload(s) to:',CR,LF,LF,0 CALL GETKIND ; Display available categories and get choice STA SAVTYP ; Save it as ascii SUI 'A' ; 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 ; Set user STA XUSR INX H MOV A,M ; Set private drive STA XPRDRV INX H MOV A,M ; Set private user STA XPRUSR CALL SETLCK ; Turn WRTLOC back on ENDIF ; RET ; IF ASKAREA OR (DESCRIB AND ASKIND AND (NOT MSGDESC)) GETKIND:LXI D,KINDA ; Point to file descriptors MVI C,PRINT ; Display CALL BDOS CALL ILPRTB DB CR,LF DB 'Choose a category: ',0 CALL RSTLCK ; Reset WRTLOC ; GETKND: CALL CATCH ; Clear the decks CALL INPUT ; Get user's choice CPI CR ; Is it a carriage return to review selections JNZ GETKND1 ; No, check for valid category CALL ILPRTB DB CR,LF,0 JMP GETKIND ; Display his choices again ; GETKND1:CALL UCASE ; No, convert to uppercase CPI 'A' ; Choice lower than 'A' JC GETKND ; Yes, ask again CPI MAXTYP+1 ; Choice higher than MAXTYP? JNC GETKND ; Yes, ask again RET ; We have a valid category, return ENDIF ; ; end of file description area ; ============================ ; ; Send a character to the modem ; SEND: PUSH PSW ; Save the character CALL UPDCRC ; Calculate CRC ADD C ; Calculate checksum MOV C,A ; Save cksum; ; SEND1: CALL MDOUTST ; Is transmit ready JNZ SEND2 ; No, check carrier JMP MDOUTP ; So send it ; ; 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. ; SEND2: PUSH D ; Save 'DE' CALL MDCARCK ; Is carrier still on? CNZ CARCK ; If not, continue testing it POP D ; Restore 'DE' JMP SEND1 ; Else, wait for xmit ready ; ; Waits for initial NAK - 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 CANCEL (CTL-X) then the send will be ; aborted as though it had timed out. ; WAITNAK:CALL FUNCHK ; Check function keys CALL SNDABT ; Check for local abort MVI B,1 ; Timeout delay STA CONONL ; Show future diplays to local CRT only CALL RECV ; Wait up to 1 second for character JC WAITN1 ; No character this time CPI CRC ; Was it a 'CRC' request? JZ WAITK CPI KSND ; Requesting 1k? JZ SETK ; Exit if yes, otherwise set CRC CPI NAK ; A 'NAK' indicating checksum? JZ CHECKY ; Yes, so check for Ymodem batch request CPI CANCEL ; Was it a cancel (CTL-X)? JZ ABORT ; Yes, abort ; WAITN1: DCR E ; Finished yet? JZ ABORT ; Yes, abort JMP WAITNAK ; No, loop ; WAITK: MVI B,1 ; Got a 'C', wait up to 1 second for 'K' CALL RECV JC SETCRC ; Didn't get anything so not using 1k ANI 7FH CPI '{' JZ WAITK ; Disregard noisy lines CPI KSND ; Requesting 1k? JZ SETK ; Exit if yes, otherwise set CRC ; ; Turn on the flag for CRC ; SETCRC: LDA KFLG ; KFLG manually set from 'SK'? ORA A JNZ SETK ; If yes, keep it set ; SETC1: XRA A STA KFLG ; Defaults to 128 character blocks INR A STA CRCFLG ; Insures in CRC mode CALL ILPRTL DB 'CRC requested',CR,LF,0 RET ; ; Turn on the flag for 1k blocks and insure in CRC mode ; SETK: LDA MSPEED CPI MINKSPD ; 1k request for 1200 bps or more JC SETC1 ; Don't allow 1k if less than 1200 bps SETK1: STA KFLG ; Set the flag for 1k blocks STA CRCFLG ; Insures in 'CRC' mode CALL ILPRTL DB 'Ymodem requested',CR,LF,0 RET ; ; Turn on checksum flag, insure sending 128 character blocks ; SETNAK: LDA BCHFLG ; In batch mode now? ORA A JNZ SETNAK1 ; If yes, exit XRA A STA CRCFLG ; Make sure in checksum mode STA KFLG ; Defaults to 128 character blocks CALL ILPRTL DB 'Checksum requested',CR,LF,0 RET ; From WAITNAK ; SETNAK1:CALL ILPRTL DB CR,LF DB '++ Checksum not used for batch mode ++',CR,LF,0 JMP WAITNAK ; If yes, ignore checksum request ; CHECKY: LDA YMODEM ; Get Ymodem batch status ORA A ; Requested? JZ SETNAK ; No, put checksum into effect MVI A,1 ; ASM didn't like the 'YES', changed to 1 JMP SETK1 ; Yes, set CRC and 1k flag ; ; 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 'A' ; .ARK or .ARC? JZ MOVEFA CPI 'L' ; How about .LBR? 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 NOLEXT ; 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 JMP MOVEF1 ; ; Handles .ARK/.ARC entries - first checks for proper type. If none specified, ; .ARK is forced. ; MOVEFA: SHLD SAVEHL LXI H,FCB+9 ; 1st extent character MOV A,M CPI ' ' JZ NOAEXT ; No extent, make one CPI 'A' ; Check 1st character in extent JNZ LBRERR INX H MOV A,M CPI 'R' ; Check 2nd character in extent JNZ LBRERR INX H MOV A,M CPI 'K' ; Check 3rd character in extent JZ MOVEF1 ; Was .ARK CPI 'C' ; May be .ARC? JNZ LBRERR ; Neither, abort ; ; 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 '++ No .ARK/.ARC/.LBR file with that name ++','$' ; MEMERR: CALL ILPRTB DB CR,LF DB '++ No library member file requested ++',CR,LF,0 JMP OPTERR ; ; Add .LBR extent to the library file name ; NOLEXT: 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 ; ; Add .ARK extent to the file name ; NOAEXT: LXI H,FCB+9 ; Location of extent MVI M,'A' INX H MVI M,'R' INX H MVI M,'K' 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) PUSH A ; In case calling routine wants it back 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 A ; In case calling routine needed it 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 A ; In case calling routine needed it POP H ; Restore all registers saved by 'CTYPE' POP D POP B RET ; ; Inline print of message, terminates with a 0 ; ILPRTB: XRA A JMP ILPRTL+2 ; ILPRTL: MVI A,1 STA CONONL ; 1=local only, 0=both local and remote ; ILPRT: XTHL ; Save HL, get HL=message ; ILPLP: MOV A,M ; Get the character INX H ; To next character ORA A ; End of message? JZ ILPRET ; Yes, return CALL CTYPE ; Type the message JMP ILPLP ; Loop ; ILPRET: XTHL ; Restore HL RET ; Past message ; IF ACCESS NOACC: CALL ERXIT DB '>>> Restricted Function - Access Denied <<<','$' ENDIF ; ; Inline print of message - terminates with '$' ; CLEARIT: IF CLRSCRN CALL PRINTL DB CLRCH1,CLRCH2,CLRCH3,CLRCH4,CLRCH5,CLRCH6,'$' RET ; PRINTL: MVI A,1 STA CONONL ; Just to make sure, set to local display only ; PRINTL1:POP H MOV A,M ; Get character INX H ; Increment to next character PUSH H ; Save address CPI '$' ; End of message? RZ ; Yes, return CALL CTYPE ; No, print it on console JMP PRINTL1 ; Loop until done ENDIF ; RET ; ; Exit printing message following call ; ERXIT: CALL ILPRTB DB CR,LF,0 ; ERXIT1: POP H ; Get address of next character MOV A,M ; Get character INX H ; Increment to next character PUSH H ; Save address CPI '$' ; End of message JZ EXITXL ; If '$' is end of message CALL CTYPE ; Else print character on console JMP ERXIT1 ; And repeat until abort/end ; EXITXL: CALL ILPRTB DB CR,LF,0 ; ERXITX: POP H ; Restore stack CALL CATCH ; Clear the input XRA A STA OPTSAV ; Reset option to 0 for TELL STA MSGFLG ; Reset the message file upload flag 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 JMP BDOS ; Now do it ; 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 JMP BDOS ; Do it ; ; ; This subroutine determines the status of the ZCPR WHEEL byte. Calls are made ; to this subroutine regardless of whether ZCPR is set YES or NO. If ZCPR is ; set NO, all returns result with the Zero flag set. If ZCPR is YES, all ; returns will reflect the true value of location WHEEL. ; WHLCHK: IF ZCPR LDA WHEEL ORA A RET ENDIF ; IF NOT ZCPR XRA A RET ENDIF ; ; ; Get a character, if none ready wait up to DESWAIT minutes, then abort the ; program. This subroutine taken from description routines, but placed here ; to be accessible by the Help Guide routines. ; INPUT: PUSH H ; Save current values PUSH D PUSH B LDA DESWAIT ; Outer loop count (about 2 minutes) ADD A MOV L,A ; Save it ; INPUT1: LXI D,300 ; Approximately a 30 second loop ; INPUT2: LXI B,MHZ*77 ; Gives about 100 ms ; INPUT3: PUSH H PUSH D ; Save the outer delay count PUSH B ; Save the inner delay count MVI C,DIRCON ; Get console status MVI E,0FFH CALL BDOS ANI 7FH POP B ; Restore the inner delay count POP D ; Restore the outer delay count POP H 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 PUSH H CALL SENDBEL ; 30 seconds passed - no input POP H DCR L ; Countdown DESWAIT period JNZ INPUT1 ; Start next 30 second timer ; IF DESCRIB OR MSGDESC MVI A,CR CALL OUTCHR MVI A,LF CALL OUTCHR LXI SP,STACK ; Restore the stack CALL EXPL5 ENDIF ; JMP EXIT ; Finished ; INPUT4: POP B POP D POP H RET ; ; Send a bell just to the modem ; SENDBEL:CALL MDOUTST ; Is modem ready for another character? JNZ SENDBEL ; If not, wait MVI A,7 PUSH PSW JMP MDOUTP ; Send to the modem only ; ; ; ================== ; CRC Subroutines: ; ================== ; CRCCHK: PUSH H ; Check 'CRC' bytes of received message LHLD CRCVAL MOV A,H ORA L POP H RZ ; Return with zero flat set if ok MVI A,0FFH ; Else clear the flag to show an error RET ; FINCRC: PUSH PSW ; Finish 'CRC' calculation for last xmsn 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 ; ; ; ================== ; LOGCAL Routines: ; ================== ; ; Main log file routine, adds record to log file ; LOGCALL: IF LOGCAL MVI C,CURDRV ; Get current disk CALL BDOS ; (where down/upload occurred) STA DSKSAV MVI C,SETUSR ; Get current user area MVI E,0FFH ; (where down/upload occurred) CALL BDOS STA USRSAV 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 ILPRT DB CR,LF DB '++ No LASTCALR.??? file found ++',0 RET ; Now go send EOT ; 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,STDMA CALL BDOS LXI D,FCBCALLER ; Read first (and only) record MVI C,RRDM CALL BDOS LXI H,DBUF ; Set pointer to beginning of record ENDIF ; LOGCAL ; IF LOGCAL AND CLOCK LXI D,0 ; Zero DE MVI A,LCNAME ; Offset-1 to start of caller's name DCR A ; Now correct offset MOV E,A ; To E DAD D ; HL now points to start of name ENDIF ; IF LOGCAL SHLD CALLERPTR LXI D,LOGBUF ; Set DMA address to LOGBUF MVI C,STDMA 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, continue CALL ILPRT ; File create error DB CR,LF DB '++ No directory space: LOG ++',0 RET ; Go back and send EOT ; 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: LXI D,LOGBUF ; Set DMA to LOGBUF MVI C,STDMA CALL BDOS MVI C,FILSIZ ; Get file length LXI D,FCBLOG CALL BDOS 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 ENDIF ; LOGCAL ; IF LOGCAL AND ACCESS AND PUPOPT LDA PUPFLG ORA A ; Privileged upload option request? JZ LOGC7 ; No MVI A,'P' ; ...else, JMP LOGC8 ; Show as private upload for log file ENDIF ; IF LOGCAL LOGC7: LDA LOGOPT ; Get option back and put in file ; LOGC8: CALL PUTLOG LDA MSPEED ; 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 seconds 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 LBRARC ORA A ; Member extraction? JZ WDRV1 ; No, won't be member name 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 LBRARC ORA A ; Member extraction? JZ WDRV2 ; No, won't be member name MVI C,1 JMP SPLOOP ; WDRV2: MVI C,13 ; SPLOOP: PUSH B CALL PUTSP ; Put ' ' POP B DCR C JNZ SPLOOP LHLD RECDNO ; Get record count CALL DIVREC ; Divide record count by 8 ; EXKB2: CALL PNDEC3 ; Print to log file (right just xxxk) LXI H,LOGK ; 'k ' MVI B,2 CALL PUTSTR XRA A STA COMMA ; Reset field counter ENDIF ; LOGCAL ; IF LOGCAL AND CLOCK 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 ; Get current time STA MINSAV ; Save min MOV A,B ; Get current hour CALL PNDEC ; Print hr to file MVI A,':' ; With ':' CALL PUTLOG ; Between HH:MM LDA MINSAV ; Get min CALL PNDEC ; And print min CALL PUTSP ; Print a space ENDIF ; IF LOGCAL CLOOP: CALL GETCALLER ; And the caller CPI EOF JZ QUIT CPI CR ; Do not print 2nd line of 'LASTCALR' JNZ CLOP1 ; CEND: CALL PUTLOG MVI A,LF CALL PUTLOG ; And add a LF JMP QUIT ; CLOP1: CPI ' ' ; Space? JNZ CLOP1A ; No, check for comma MVI A,',' ; Convert space to comma for field checking ; CLOP1A: CPI ',' ; Comma? JNZ CLOP2 LDA COMMA CPI 1 ; Is this the second comma or space? JNZ CLOP1B ; No, bump the counter MVI A,CR JMP CEND ; Yes, stop taking data from lastcalr ; CLOP1B: INR A ; Bump it one STA COMMA MVI A,' ' ; Instead send a ' ' ; CLOP2: CALL PUTLOG JMP CLOOP ; 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 ILPRT ; If error, oops DB CR,LF DB '++ Can''t close log ++',CR,LF,0 RET ; Go back and send EOT ; ; ; ========================== ; LOGCAL Support Routines: ; ========================== ; ; Gets a single byte from DBUF ; 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 ENDIF ; IF CPM3 AND LOGCAL PUSH D ; Save FCB address LXI D,80H MVI C,STDMA CALL BDOS ; Set DMA to 80H POP D ; Get back pointer to FCB PUSH D ; Save FCB pointer again MVI C,SRCHF ; Search for first match CALL BDOS INR A ; Did file match? POP D RZ ; No, return PUSH D DCR A ; A=directory code (0-3) ADD A ; *2 ADD A ; *4 ADD A ; *8 ADD A ; *16 ADD A ; *32 MOV E,A MVI D,0 LXI H,TBUF ; Add (32*dir code) to default DMA DAD D ; to find first match filename POP D ; DE=FCB PUSH D ; Save DE again INX H ; Move HL past user # byte in buffer INX D ; Move DE past drive # byte in FCB MVI B,11 CALL MOVE ; Move name found to FCB POP D ; And continue with open ENDIF ; IF LOGCAL MVI C,OPEN ; Open file CALL BDOS CPI 0FFH ; Not present? RET ; Return to caller ; ; Write character to log file ; PUTLOG: LHLD LOGPTR ; Get pointer 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 ILPRT DB CR,LF DB '++ Disk Full - Can''t add to log ++',0 RET ; 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 ; DECOT3: ADI '0' CALL PUTLOG ; DECOT4: 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 ; ; ; ========================= ; TIME and DATE Routines: ; ========================= ; ; Calculate time on system and inform user. Log him off if =>MAXMIN unless ; STATUS is non-zero. ; IF TIMEON OR BYEBDOS TIME: PUSH B ; Save BC pair CALL GETTIME ; Get time from system's RTC STA CMTEMP ; Save in current-mins-temp MOV A,B ; Get current hour POP B ; Restore BC ENDIF ; IF BYEBDOS PUSH A ; save the current hour <== BUG FIX PUSH B ; Lhour was safely moved to highmem PUSH D ; in newer versions of BYE MVI C,79 CALL BDOS LXI D,11 ; Get address of LHOUR DAD D POP D POP B POP A ; 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 OR BYEBDOS 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 TIMEON OR BYEBDOS CALL WHLCHK ; Check wheel status if ZCPR JNZ TIME3 ; If not then this is a special user LDA MAXTOS ORA A ; If maxtos is zero, guy is superuser JZ TIME3 ENDIF ; IF TIMEON AND (NOT BYEBDOS) LDA STATUS ORA A ; Special user? JNZ TIME3 ; Yes, skip log off check LDA TON SUI MAXMIN ; Subtract max time allowed ENDIF ; IF BYEBDOS LDA MAXTOS MOV B,A LDA TON SUB B ENDIF ; IF TIMEON OR BYEBDOS 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 ILPRTB ; MSG1: DB CR,LF DB 'Time on system is 00 minutes',CR,LF,0 ENDIF ;TIMEON OR BYEBDOS ; IF TIMEON AND (NOT BYEBDOS) LDA STATUS ; Check user status ORA A ; Special user? JNZ TIME5 ; Yes, reset TON ENDIF ; IF TIMEON OR BYEBDOS RET ; TIME5: MVI A,0 ; Reset timeout for good guys STA TON RET ; TIMEUP: CALL ILPRTB DB CR,LF,LF DB 'Your time is up - wait 24 hours to call back',CR,LF,0 RET ENDIF ; TIMEON OR BYEBDOS ; ; ; Get caller's time on system from BYE3 or MBYE and display on console. ; IF B3RTC AND DTOS TIME: CALL ILPRTB DB CR,LF DB 'Time on system is ',0 CALL GETTOS ; Get Time On System from MBYE's RTC CALL DECOUT ; Print it on the screen CALL ILPRTB 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,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 ; ; ; ================ ; Date Routines: ; ================ ; 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 ENDIF ; End of CP/M+ date routines ; ; 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 ; GETBDAT:LHLD RTCBUF ; Get RTC buffer in HL ENDIF ; IF LOGCAL AND BYEBDOS AND (NOT B3RTC) MVI C,79 ; 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 YEAR ; Save YY INX H ; Point to MM MOV A,M ; Get MM CALL BCDBIN ; Convert BCD to binary STA MONTH ; 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 YEAR ; Get YY MOV C,A ; Put YY in C LDA MONTH ; 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,79 ; 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 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 KFLG ; Turn off 1k blocks RET ; ; ; ========================== ; BYEBDOS Access Routines: ; ========================== ; IF BYEBDOS CONOUT: MOV E,C ; Get character into E MVI C,68 ; Console output (local only) JMP BDOS ; Go to it... ; MINIT: UNINIT: RET ; Modem's already initialized ; MDOUTP: POP PSW ; Needed by specifications PUSH B PUSH D PUSH H MOV E,A ; Put character in E MVI C,63 ; Modem output 8 bit char CALL BDOS POP H POP D POP B RET ; GETCHR: MDINP: PUSH B PUSH D PUSH H MVI C,64 ; Modem input 8 bit char 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" ; MDCARCK:PUSH B PUSH D PUSH H MVI C,65 ; Modem carrier status CALL BDOS JMP BKWDS ; MDINST: PUSH B PUSH D PUSH H MVI C,61 ; Modem raw input status CALL BDOS JMP BKWDS ; MDOUTST:PUSH B PUSH D PUSH H MVI C,62 ; Modem raw output status 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 ; ; ; ============= ; ; DEC8 will convert an 8 bit binary number in A to 3 ASCII bytes. HL points ; to the MSB location where the ASCII bytes will be stored. Any leading zeros ; are suppressed, so store spaces in your buffer before ; calling. ; DEC8: PUSH B PUSH D MVI E,0 ; Leading zero flag MVI D,100 ; DEC81: MVI C,'0'-1 ; DEC82: INR C SUB D ; 100 or 10 JNC DEC82 ; Still + ADD D ; Now add it back MOV B,A ; Remainder MOV A,C ; Get 100/10 CPI '1' ; Zero? JNC DEC84 ; Yes MOV A,E ; Check flag ORA A ; Reset? MOV A,C ; Restore byte JZ DEC85 ; Leading zeros are skipped ; DEC84: MOV M,A ; Store it in buffer pointed at by HL INX H ; Increment storage location MVI E,0FFH ; Set zero flag ; DEC85: MOV A,D SUI 90 ; 100 to 10 MOV D,A MOV A,B ; Remainder JNC DEC81 ; Do it again ADI '0' ; Make ASCII MOV M,A ; And store it POP D POP B RET ; ; ; ============= ; ; The following allocations are used by the LOGCALL routines ; IF LOGCAL PGSIZE: DB 0,0,0 ; Program length in mins and secs 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 DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 CALLERPTR: DW LOGBUF FCBLOG: DB 0,'KMD LOG' DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 LOGPTR: DW DBUF LOGCNT: DB 0 LOGK: DB 'k ' ENDIF ; ; DSKSAV: DB 0 ; Up/download disk saved here USRSAV: DB 0 ; Up/download user saved here YEAR: DB 0 ; Current Year stored here MONTH: DB 0 ; Current Month stored here DAY: DB 0 ; Current Day stored here MINSAV: DB 0 ; CMTEMP: DB 0 ; Storage for current minute value MAXTOS: DB 0 ; Maximum time on system RTCBUF: DW 0 ; Address of RTCBUF saved here TON: DB 0 ; Time On (If TIMEON or BYEBDOS) TLOS: DB 0 ; Time Left On System TOSSAV: DW 0 ; Time On System (If B3RTC) ; ; ; ============= ; ; Batch stuff ; BCHADR: DW DBUF ; For multiple descriptions BCHPTR: DW 0 BGNMS: DW 0 ; Start address of filenames in TBUFF BLOKK: DW 0 ; # of 2k blocks required by remote BUFADR: DW DBUF ; For multiple file display ; BCHFLG: DB 0 ; Batch mode flag DISKNO: DB 0 FCBBUF: DB 0,0,0,0,0 ; Batch filename from command line DB 0,0,0,0,0,0 DB 0,0,0,0,0,0 FILCNT: DB 0 ; # of files in batch mode FSTFLG: DB 0 ; Set to 1 when command line scan done FTYCNT: DB 0 MFFLG1: DB 0 MFNAM5: DB 0,0,0,0,0,0 DB 0,0,0,0,0,0 MFNAM6: DB 0,0,0,0,0,0 DB 0,0,0,0,0,0 NAMECT: DB 0 ; # of names on command line NBSAVE: DB 0,0 ; Start address in NAMBUF for next file SHOCNT: DB 0 ; Counter to show files left SNDFLG: DB 0 ; TOTREC: DB 0,0 ; Total records to be sent ; ; ; ============= ; ; Temporary storage area ; IF DESCRIB OR MSGDESC FILE: DB 0,'FOR ' DB 0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0 ; DEST: DB 0,' $$$' DB 0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0 ENDIF ; IF TIMEON AND CPM3 TIMEPB: DS 4 ; Storage for the system date and time ENDIF ; DUSAVE: DB 0,0,0,0 ; Buffer for drive/user MEMFCB: DB ' ' ; Library name (16 bytes required) ; ARCCNT: DW 0 ; .ARK/.ARC record count ARCMRK EQU 26 ; Header mark ARCEOF: DB 0 ; EOF flag for .ARK/.ARC ARCFST: DB 0 ; First record flag ARCLST: DB 0 ; Last record byte count -1 ARCPTR: DW 0 ; Record pointer ARCREC: DW 0 ; Record number ARCVER: DB 0 ; Flag for compression type (1-8) HDRSIZ EQU 28 ; Header size (version 1 = HDRSIZ-4) ; AFBYTE: DB 0 ; Access flags byte storage ANYET: DB 0 ; Any description typed yet? BLKSHF: DB 0 CHKASK: DB 0 ; First time wrap mode prompt CHKEOT: DB 0 ; Prevents locking up after an EOT CHRCNT: DB 0,0,0 ; Character counter for description CRCFLG: DB 0 ; For sending checksum rather than CRC CONONL: DB 0 ; CTYPE console-only flag COMMA: DB 0 ; Field counter for logcal DSCFLG: DB 0 ; This flag indicates MSGDESC mode if set DRUSER: DB 0 ; Original drive/user, for return DUD: DB 0 ; Specified disk DUU: DB 0 ; Specified user EOFLG: DB 0 ; 'EOF' flag (1=yes) EOTFLG: DB 0 ; EOT (End of transmission) status flag ERRCT: DB 0 ; Error count FRMSPC: DB 0 ; For description routines, if '1' from SPACE: FRSTIM: DB 0 ; Turned on after first 'SOH' received GOTONE: DB 0 ; Prevents asking for a description KIND: DB 0 ; Asks what kind of file this is KFLG: DB 0 ; For sending 1k blocks LBRARC: DB 0 ; .LBR/.ARK/.ARK request flag MSGFLG: DB 0 ; Special flag for messge uploads NODASH: DB 0 ; Set at the first '-' in category text 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 PUPFLG: DB 0 ; Special flag for privileged option uploads PRVTFL: DB 0 ; Private user area option flag RCVCNT: DB 0 ; Record number received RCVDRV: DB 0 ; Requested drive number RCVTRY: DB 0 ; Keeps track of number of attempts RCVUSR: DB 0 ; Requested user number SAVTYP: DB 0 ; Storage for upload type (ASKAREA or ASKIND) SPLFL: DB 0 ; Special flag for private downloads SYSABT: DB 0 ; Local sysop transfer abort with ^x UPDRV: DB 0 ; Drive upload received on stored here UPUSR: DB 0 ; User upload received on stored here YMODEM: DB 0 ; Special flag for Ymodem batch xfr (CRC-1k) ; ACCERR: DW 0 ; No 'ACK' error count for 1k ratio BLKMAX: DW 0 CRCVAL: DW 0 ; Current CRC value DIRSIZ: DW 0 ; Directory size INDEX: DW 0 ; Index into directory MINUTE: DW 0 ; Transfer time in mins for MAXTIM OUTADR: DW DBUF OUTPTR: DW 0 OUTSIZ: DW BSIZE RCNT: DW 0 ; Record count RECDNO: DW 0 ; Current record number RCDCNT: DW 0 ; Used in sending the record header RECPTR: DW DBUF RECNBF: DW 0 ; Number of records in the buffer SAVEHL: DW 0 ; Saves TBUF command line address ; HLINE: IF DESCRIB AND (NOT MSGDESC) DB '-----',CR,LF ENDIF ; IF MSGDESC AND (NOT DESCRIB) DB 'Msg#: ????',CR,LF DB 'From: ',CR,LF DB ' To: ALL',CR,LF DB ' Re: NEW UPLOAD: ',0 HLINE2: DB ' ',CR,LF ENDIF ; IF DESCRIB OR MSGDESC HLINE3: DB CR,LF,'$',0 ENDIF ; DATMSG: DB ' Rcvd: ',0 ; Used with DSTAMP (shows date upload recieved) OLINE: DS 80 ; Temporary buffer to store line DS 60 ; Area for stack ; ; ; ============ ; BDOS equates ; ============ ; RDCON EQU 1 ; Input from console WRCON EQU 2 ; Output to console DIRCON EQU 6 ; Direct console output PRINT EQU 9 ; Print string function 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 STDMA EQU 26 ; Set DMA SETUSR EQU 32 ; Set user area to receive file RRDM EQU 33 ; Read random WRDM EQU 34 ; Write random FILSIZ EQU 35 ; Compute file size SETRRD EQU 36 ; Set random record BDOS EQU 0005H ; Address for BDOS jump vectors TBUF EQU 0080H ; Default DMA address FCB EQU 005CH ; System FCB FCB1 EQU 006CH ; Secondary FCB area FCBEXT EQU FCB+12 ; File extent FCBRNO EQU FCB+32 ; Record number RANDOM EQU FCB+33 ; Random record field ; ; ; ============== ; ; These equates are normally not changed by the user ; VERS EQU 1 ; Version number MODLEV EQU 2 ; Major modification level REV EQU 0 ; Minor modification level VMONTH EQU 02 VDAY EQU 17 VYEAR EQU 87 ; ; ASCII characters used ; BELL EQU 07H ; Bell BS EQU 08H ; Backspace character ACK EQU 06H ; Acknowledge CANCEL EQU 18H ; CTL-X for cancel CR EQU 0DH ; Carriage return CRC EQU 'C' ; CRC request character KSND EQU 'K' ; 1k block 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 STX EQU 02H ; Start of 1k header ; ; ; 16k disk buffer ; ORG ($+127)/128*128 ; CMDBUF: DS 128 ; Store TBUFF here in batch mode STACK EQU CMDBUF-2 NAMBUF: DS 24*128 ; Allow room for 50 batch filenames DBUF: DS 128*128 ; 16k disk buffer BUFSTR EQU DBUF+126 ; For file length in batch mode LOGBUF EQU DBUF+128 ; For use with LOGCAL ; ; END