; ; MB-KMD ver. 1.10 - 07/30/86 ; ; MB-KMD11.ASM - REMOTE CP/M FILE TRANSFER PROGRAM ; ;========================================================================= ; ; MB-KMD is placed in the Public Domain. It may be updated or altered, ; but should again be placed in the Public Domain. If you modify or fix ; this program in any way, send a copy of your changes as a .DQF file ; produced by DIF/SQ to my system below. Many changes are planned, so ; central coordination of updates/fixes and new overlays will be needed. ; If you have an XMODEM overlay for your system setup, that has not been ; readily available in the Public Domain, it would be much appreciated ; if you would forward it also. ; ; >> PLEASE, DO NOT RELEASE YOUR VERSION DIRECTLY TO THE PUBLIC DOMAIN << ; ; MB-KMD provides 100% support for all popular BBS software (i.e. MBBS, ; METAL, Oxgate, PBBS, RBBS, ZBBS, etc) and communications software (i.e. ; PROCOMM, QMODEM, PRO-YAM, MEX+, MEX, MDM, IMP, etc). If you've been ; using the XMODEM or KMD series, you'll find many new features - AND it's ; easy to install. Those of you who have been using the KMD series will ; find full support with MB-KMD no matter what BYE program you're running, ; in addition to better features, as will you XMODEM users. ; ; MB-KMD is a COMPLETE Stand Alone program, it does NOT need a BYE program ; (although MB-KMD fully supports any BYE program that I'm aware of) and ; will run under a standard CP/M after establishing carrier with your own ; terminal program. (After establishing carrier, you can drop to CP/M and ; run MB-KMD to receive or send with 1k and BATCH protocols. ; ; To see what recent/past revisions have taken place within MB-KMD, read ; the MB-KMD.HIS file. MB-KMD.HLP may be placed online for user download, ; as it gives a bit more detail about MB-KMD usage/commands than the ; shorter help examples given by MB-KMD itself. ; ; MB-KMD is the result of no one authorship, but a combination of XMODEM ; NUKMD which have been contributed to by many hundreds of people across ; the country. The source code is fully commented to aid those of you who ; wish to customize/modify it or who are trying to understand how programs ; such as this work. ; ; If you have changes that you feel should be included in future releases, ; please forward them me. All submitted modifications/suggestions will be ; considered, whether they are from an individual or a group. FULL credit ; will also be given for such code as is incorporated into future versions ; (i.e. system name and number, as well as the person's name). ; ; - Bob Kramer ; Rock Island RCP/M (PBBS) ; 300/1200/2400 ; (309) 786-6227 ; ;========================================================================= ; ; CURRENT UPDATES ; v1.10 ; 07/30/86 ; ;* Implemented menu driven help guide. Also reworded the examples to make ; more sense. ; Bob Kramer ;* Allow setting of the lowest baud rate allowed to use 1k protocol. Some ; long distance telephone services use a lengthy delay to send back and ; forth -- PC Pursuit is an example of this. Using 1k protocol will ; drastically reduce the time needed to transfer files at any baud rate, ; even at 300 baud under these circumstances. ; Bob Kramer ;* In BATCH mode, LOGCAL routines were not resetting COMMA count after the ; first BATCH transfer, causing the callers last name to not be included ; in the log file - only his first name. Simply added code to zero comma ; counter at label EXKB2: ; Michael Conley ;* If there was no BYE running, and an attempt to run MB-KMD as a true ; Stand Alone, the CONOUT VECTOR address was being looked at as though ; there were a BYE running, this was causing a system hang up at the ; point where local console output was needed only. The code was in ; XMODEM properly and this was just an error on my part, but at any rate, ; this is now fixed just after label NOBYE0: at the conditional IF USECON ; AND NOT BYEBDOS. ; Bob Kramer ;* Cleaned up miscellaneous routines, MB-KMD now sets up the access flag ; byte (AFBYTE) one time only, instead of setting this byte up in 6 ; different parts of the program. Saves a few bytes. ; Bob Kramer ;* Added code and equate to set SYSTEM attribute on uploaded files so they ; would be invisible until released by SYSOP. See HIDEIT equate. Also if ; clock routines provide the date it will be appended to the first line ; of the upload description written to the FOR.TXT file as: ; Rcvd: 00/00/00 if the DSTAMP equate is set to YES. ; Michael Conley ;* BLIMIT needed to be converted to ASCII, made appropriate fixes. Also ; fixed a few routines for RTC and MAXTIM. ; Michael Conley ; ;========================================================================= ; NOTE: This program assembles with ASM, LASM, MAC, RMAC, M80 or SLRMAC) ; VERS EQU 1 ; Version number MODLEV EQU 1 ; Modification level REV EQU 0 ; Revision (anything other than '0' reflects beta) MONTH EQU 07 DAY EQU 30 YEAR EQU 86 ; NO EQU 0 YES EQU NOT NO ; ; ; Define 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 ; ; ; =============================================================== ; Conditional equates - change to suit your system, then assemble ; =============================================================== ; MHZ EQU 4 ; Processor speed, use integer (2,4,5,8, etc.) CPM3 EQU NO ; Yes, using if using CP/M 3.0 and LOGCAL is YES MSPEED EQU 3CH ; Location of BYE's modem speed indicator STOPBIT EQU NO ; No, if using 1 stop bit, yes if using 2 BYEBDOS EQU YES ; Yes, using BYEBDOS - No, using XMDM overlay ; LARGEIO EQU NO ; Yes, if XMDM patch area is over 128 bytes LARSIZE EQU 0 ; If 'LARGEIO' set patch area size (bytes) here ; ; ============= ; ; If ZCPR = YES, these will all be available when WHEEL byte is set. ; ZCPR EQU YES ; Yes, NO filetypes .NDR or .RCP received WHEEL EQU 3EH ; Location of ZCPR wheel byte (normally 03EH) NOCOMR EQU YES ; Yes, change .COM to .OBJ and .PRL to .OBP NOCOMS EQU YES ; Yes, .COM files not sent NOLBS EQU YES ; Yes, .??# files not sent NOSYS EQU YES ; Yes, no $SYS files sent or reported ; ; Allows drive/user area to be specified for downloading. If using ZCPR ; set USEMAX 'YES'. Then the answers to MAXDRV and MAXUSR are superfluous. ; USEMAX EQU YES ; Yes, if using ZCPR for DRIVMAX & USRMAX values DRIVMAX EQU 03DH ; Location of MAXDRIV byte (IF USEMAX) USRMAX EQU 03FH ; Location of MAXUSER byte (IF USEMAX) MAXDRV EQU 3 ; Number of disk drives used (IF NOT USEMAX) MAXUSR EQU 0 ; Maximum 'SEND' user allowed (IF NOT USEMAX) ; ; ============= ; PRDRV EQU 'A' ; Private drive for SYSOP to receive file PRUSR EQU 13 ; Private user area for SYSOP to receive file SPLDRV EQU 'A' ; Special drive area for downloading SYSOP files SPLUSR EQU 11 ; Special user area for downloading SYSOP files SETAREA EQU YES ; Yes, if using designated area to receive files DRV EQU 'C' ; Drive to receive file on (IF SETAREA) USR EQU 0 ; User area to receive file in (IF SETAREA) HIDEIT EQU NO ; If YES, uploads are set as SYSTEM files ACCESS EQU YES ; Yes, check flags for upload/dwnld restrictions ACBOFF EQU 21 ; No. of bytes from JMP COLDBOOT to ACCESS byte. ACWRIT EQU 8 ; Bit to test for BBS msg write OK (1=OK,0=NOT OK) ACDNLD EQU 32 ; Bit to test for downloads OK (1=OK,0=NOT OK) ACUPLD EQU 64 ; Bit to test for uploads OK (1=OK,0=NOT OK) ACPRIV EQU 128 ; Bit to test for privileged user OK (1=OK,0=NOT OK) TAGFIL EQU NO ; Yes, send members but not F1 tagged library files ; and don't send F2 tagged single files. DWNTAG EQU NO ; Yes, files with F3 attribute bit can be ; downloaded regardless of access byte restrictions MSGFIL EQU NO ; Yes, your BBS supports message file uploads BLIMIT EQU 50 ; No. files allowed in BATCH upload mode (255 max) MINKSPD EQU 1 ; Lowest speed to send 1k protocol. (1=300, 5=1200) BUFSIZ EQU 16 ; File transfer buffer size in Kbytes USECON EQU YES ; Yes, get CONOUT address from BYE. No, from XMDM ovl. CONOFF EQU 15 ; Offset to COVECT where original console output ; routine address is stored in BYE/MBYE TIMOUT EQU 1 ; Seconds to abort after carrier loss CONFUN EQU YES ; Yes, check local console for function keys WRTLOC EQU YES ; Yes, set/reset WRTLOC so BYE won't hang up LOCOFF EQU 12 ; Offset to WRTLOC flag ; ; ============= ; DESCRIB EQU YES ; Yes asks for a description of uploaded file ; (MSGDESC must be NO) DSTAMP EQU NO ; Yes adds a datestamp to the first line of the ; description in FOR.TXT ; MSGDESC EQU NO ; Yes, use your message base for upload descriptions ; (MSGFIL must be set to YES, DESCRIB must be NO) ; DRIVE EQU 'A' ; Drive area for description of upload USER EQU 14 ; User area for description of upload BSIZE EQU 24*1024 ; Set for 24k for the DESCRIB buffer WRAPOPT EQU NO ; Yes, offer option of word wrap. No, wrap always WRAP EQU 63 ; Column position for word wrap. (72 to disable) PUPOPT EQU NO ; Yes, skip description request if "RW" is used DESWAIT EQU 4 ; Minutes to wait for description before hanging up ASKIND EQU YES ; Yes, ask for the category of the uploaded file ; ; ============= ; LOGCAL EQU YES ; Yes, logs MB-KMD transfers EDATE EQU NO ; Yes to show dd/mm/yy vice mm/dd/yy in XMODEM.LOG LOGDRV EQU 'A' ; Drive to place LOG file LOGUSR EQU 14 ; User area to put LOG file LASTDRV EQU 'A' ; Drive 'LASTCALR???' file is on LASTUSR EQU 14 ; User area of 'LASTCALR???' file LCNAME EQU 1 ; Column # where caller's name starts in LASTCALR LOGLDS EQU YES ; Count number of up/down loads since login UPLDS EQU 054H ; Clear these values to Zero from your BBS program DNLDS EQU 055H ; ONLY when somebody logs in ; ; ============= ; ; The following equates should be set NO if BYEBDOS is YES ; B3RTC EQU NO ; Yes, your clock is setup in BYE5/NUBYE/MBYE B3COFF EQU 25 ; OFFSET from COLDBOOT: to RTCBUFF address B3CMOS EQU 7 ; OFFSET from RTCBUFF: to mins on system MBMXT EQU NO ; Yes, running MBYE with max. time on system MBMXO EQU 24 ; OFFSET from COLDBOOT: to MXML address ; ; If B3RTC is YES, download time may be limited using the following ; equates instead of using MAXMIN. MAXMIN will be the default value ; if BYE is not running. ; MTOS EQU YES ; Yes if using maximum time on system instead of ; MAXMIN to limit transmission time ; IF MTOS AND MBMXT ; both must be YES MXTOS EQU YES ; (leave YES) ENDIF ; IF NOT (MTOS AND MBMXT) ; (if either are NO) MXTOS EQU NO ; (leave NO) ENDIF ; MXTL EQU NO ; Yes if limiting transmission time to time left ; plus MAXMIN. MXTOS must be YES. ; IF MXTL AND MXTOS ; both must be YES MTL EQU YES ; (leave YES) ENDIF ; IF NOT (MXTL AND MXTOS) ; (if either are NO) MTL EQU NO ; (leave NO) ENDIF ; ; ============= ; ; The TIMEON and RTC equates should be NO if B3RTC is YES ; RTC EQU NO ; If YES, add your clock reader code at the start ; of label GETTIME: and GETDATE: below TIMEON EQU NO ; If YES, add your clock reader code to start of ; label GETTIME: and return time in registers A & B ; 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 ; ; ============= ; ; Global time options ; MBYETOS EQU YES ; Yes, time on system displayed at start TOSEXIT EQU YES ; Yes, time on system displayed on exit MAXTIM EQU YES ; Yes if limiting transmission time 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) ; ; =========================== ; End of CONFIGURATION Tables ; =========================== ; ORG 100H JMP BEGIN ; ; ; ============= ; I/O 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. (Use standard XMODEM overlays). ; IF NOT BYEBDOS CONOUT: JMP 0 ; See 'CONOUT' discussion above 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 easily 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. ; XPRDRV: DB PRDRV ; Drive to receive PRIVATE uploads XPRUSR: DB PRUSR ; User area to receive PRIVATE uploads XDRV: DB DRV ; Drive to receive REGULAR uploads XUSR: DB USR ; User area to receive REGULAR uploads XWRAP: DB WRAP ; Column where desc line wrap occurs ; ; File descriptors, change as desired. Move the line with terminating ; '$' up, if fewer descriptions desired. ; IF ASKIND AND DESCRIB KIND0: DB ' 0) - CP/M',CR,LF KIND1: DB ' 1) - MS/PC-DOS',CR,LF KIND2: DB ' 2) - RCP/M',CR,LF KIND3: DB ' 3) - Word Processing',CR,LF KIND4: DB ' 4) - Data Base Utilities',CR,LF KIND5: DB ' 5) - Pascal',CR,LF KIND6: DB ' 6) - BASIC and/or GAMES',CR,LF KIND7: DB ' 7) - Communications',CR,LF KIND8: DB ' 8) - Printer Utilities',CR,LF KIND9: DB ' 9) - Miscellaneous',CR,LF DB '$' 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 ILPRT DB CR,LF,'BYEBDOS not available...aborting...',CR,LF,BELL,0 JMP 0 ; BYEOK: MVI C,BDSTOS ; Get current maximum time on system MVI E,255 CALL BDOS STA MAXTOS ; Store it MVI E,0 MVI C,BDSTOS ; Stop BYEBDOS from checking time just now CALL BDOS MVI C,BDGRTC ; Ask for TON and RTC address CALL BDOS STA TON ; Save time on system PUSH B LDA TON ; Get time-on-system MOV B,A ; Save it LDA MAXTOS ; Get MXTIME SUB B ; MXTIME-TON=TLOS (Time left on system) STA TLOS ; And store it POP B ENDIF ; IF B3RTC AND MXTOS AND (NOT BYEBDOS) CALL BYECHK ; If BYE not active MVI A,MAXMIN ; (we'll use MAXMIN as default) JNZ EXTMXT ; Skip MXML update LHLD 0001H ; Get JMP COLDBOOT DCX H MOV D,M DCX H MOV E,M LXI H,MBMXO ; + MBMXO offset to MXML DAD D MOV A,M ; = max time allowed on system ; EXTMXT: STA MAXTOS ; Store max download time ENDIF ; IF RTC AND MAXTIM AND ZCPR LDA WHEEL ; See if it's that SYSOP ORA A JNZ NOLIMIT ; If WHEEL set, leave MAXTOS at zero ENDIF ; IF RTC AND MAXTIM 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 NOBYE0 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 ; NOBYE0: IF CONFUN ; Console status checks to be done? LHLD 0001H ; If so get addr of warmboot (jmp table) INX H INX H INX H ; + 3 = address of console status check SHLD CONCHK+1 ; Stuff after call for FUNCHK SHLD CKABORT+1 ; Stuff after call for CKABORT INX H ; INX H INX H ; + 3 = address of console inputI SHLD CKABRT+1 ; Stuff after call for CKABRT ENDIF ; IF WRTLOC ; Set write lock? CALL SETLCK ENDIF ; 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 for now MVI C,CURDRV ; Get the current drive CALL BDOS STA OLDDRV ; Save for now ; IF RTC OR MBYETOS CALL TIME ; Get user's time status ENDIF ; CALL ILPRT DB CR,LF,'MB-KMD v',VERS+'0','.',MODLEV+'0',REV+'0',' - ' DB MONTH/10+'0',MONTH MOD 10+'0','/' DB DAY/10+'0',DAY MOD 10+'0','/' DB YEAR/10+'0',YEAR MOD 10+'0',0 ; ; Stuff address of BIOS CONOUT vector in our routine as default. ; IF USECON AND NOT BYEBDOS LHLD 0001H ; Point to warm boot for normal BIOS LXI D,9 DAD D ; Calc addr of normal BIOS conout vector SHLD CONOUT+1 ; Save in case no BYE program is active CALL BYECHK ; BYE IS RUNNING, JUST NEED VECTOR JNZ NOBYE XCHG ; Point to the console output routine SHLD CONOUT+1 ; Save vector address supplied by BYE ENDIF ; ; Gobble up garbage characters from the line prior to receive or send ; NOBYE: CALL CATCH ; ; 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 'A' ; Show available upload space? JZ SPACE CPI 'L' ; To send a file from a library? JZ CHKSND CPI 'S' ; To send a normal file? JZ CHKSND CPI 'R' ; Going to receive a file? JNZ OPTERR ; None of these, show help guide ; IF ACCESS LDA AFBYTE ANI ACUPLD ; Test upload access bit JNZ RCVACC ; If bit on, uploads OK CALL ERXIT DB CR,LF,'Sorry, but you are not allowed to upload files ' DB 'at this time...$' ENDIF ; RCVACC: LDA MSPEED CPI MINKSPD ; Lowest baud rate allowed for 1k JC $+6 ; 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 ' ' ; Next column a space character? JZ RCKBCH ; If yes, see if requesting batch CPI 'B' ; For batch mode JZ RCKBCH CPI 'C' ; Want checksum? JZ RCKSM CPI 'X' ; Want 128-character blocks? JZ R128 CPI 'P' ; Want a 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 CKROPT ; Check for more options ENDIF ; CKROP1: IF MSGFIL CPI 'M' ; Message file? ENDIF ; JNZ OPTERR ; None of these, it's an error ; IF MSGFIL STA MSGFLG ; Else set the message flag MVI A,'P' ; ...and... ENDIF ; SETPRV: STA PRVTFL ; Set the private flag ; ; Have asked for a private upload so check for "B", "C" or "X" request ; JMP CKROPT ; R128: XRA A ; Reset the 1k block flag STA KFLG JMP RCRC ; CHKSND: IF DWNTAG ; allow F3 tagged files to be sent LDA FCB+3 ; regardless of access byte? ANI 80H ; If so, allow it if F3 set regardless JNZ SNDFOK ENDIF ; ; Check for ACCESS RIGHTS ; IF ACCESS LDA AFBYTE ANI ACDNLD ; Test download access bit JNZ SNDFOK ; If bit on, downloads OK CALL ERXIT DB CR,LF,'Sorry, but you are not allowed to download files ' DB 'at this time...$' ENDIF ; SNDFOK: INX H ; Next space on command line MOV A,M ; Get the character CPI 'B' ; Requesting batch mode? JNZ SNDFOK1 ; No, so continue MVI A,1 STA YMODEM ; Prep for YMODEM batch send JMP SBCH ; SNDFOK1:CPI 'X' ; Was it an 'X' for XMODEM protocol? JZ SNDFL ; If yes go send the file CPI 'P' ; Was it a 'P' for private? JNZ SNDFOK2 ; No STA SPLFL ; Set the "send private" flag JMP SNDFOK ; Check for any other requests ; SNDFOK2:CPI 'K' ; A 'K' to force 1k transmissions? JNZ SNDFL ; If not, continue normally STA KFLG ; Else set the 1k flag CALL ILPRT DB ' - (1k enabled)',0 JMP SNDFL ; ; 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 CALL BCHMSG ; Show batch enabled message JMP RCVFL ; RCRC: MVI A,1 STA CRCFLG ; Show in CRC mode CALL ILPRT DB ' - (CRC enabled)',CR,LF,0 JMP RCVFL ; All set to receive a file, now ; RCKSM: XRA A STA CRCFLG STA KFLG ; Can't use 1k blocks with checksum CALL ILPRT DB ' - (Checksum enabled)',CR,LF,0 JMP RCVFL ; ; Displays the Batch enabled message for send ; 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 JMP SNDFL ; BCHMSG: STA BCHFLG ; Set the batch flag CALL ILPRT DB ' - (Batch enabled)',CR,LF,0 RET ; ; ============= ; ; Show available upload space when KMD A is entered ; SPACE: IF WRTLOC ; Did we set the WRTLOC? CALL RSTLCK ; If so, go reset it. ENDIF ; IF NOT SETAREA CALL ILPRT DB CR,LF,LF,' Uploads to specified or current disk/user',0 ENDIF ; IF SETAREA CALL ILPRT DB CR,LF,LF,' Uploads files to ',0 LDA XDRV CALL CTYPE LDA XUSR MVI H,0 MOV L,A CALL DECOUT MVI A,':' CALL CTYPE CALL ILPRT DB ' (',0 LDA XDRV STA KDRV CALL KSHOW MVI A,')' CALL CTYPE ENDIF ; CALL ILPRT DB CR,LF,' Private files to ',0 LDA XPRDRV CALL CTYPE LDA XPRUSR MVI H,0 MOV L,A CALL DECOUT MVI A,':' CALL CTYPE ; IF SETAREA LDA XDRV PUSH H LXI H,XPRDRV CMP M ; Private same as regular drive? POP H JZ PRVSAME ; Yes, don't report 'k' this time ENDIF ; CALL ILPRT ; Report available 'k' for private DB ' (',0 LDA XPRDRV STA KDRV CALL KSHOW MVI A,')' CALL CTYPE ; PRVSAME: LDA OPTSAV ; Check to see if here from Help Guide CPI 'A' JZ PRVSME1 ; If so, we're done, skip next and exit CALL ILPRT DB CR,LF,LF,LF,0 JMP OPTERR ; PRVSME1: CALL ILPRT DB CR,LF,0 JMP EXIT ; If not, all done ; ; ============= ; ; Help Guide ; ; Either MB-KMD entered by itself for help, or an invalid option given ; OPTERR: IF WRTLOC CALL RSTLCK ENDIF ; CALL CATCH ; Clean out any leftovers CALL ILPRT DB CR,LF,LF DB 'Runtime Help Guide',CR,LF,LF DB ' eceive files from you to PBBS',CR,LF DB ' end files from PBBS to you',CR,LF DB ' vailable upload space',CR,LF DB ' ther information',CR,LF DB ' xit to CP/M',CR,LF,LF DB 'Select the HELP you need: ',0 ; GETHLP: MVI C,DIRCON ; Check keyboard status MVI E,0FFH CALL BDOS ANI 5FH ; 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 HLPSPC ; Yes, just show him CPI 'O' ; 'O' ? JZ HLPINF ; Yes, tell him about us CPI 'E' ; 'E' ? JNZ GETHLP ; No, let's ask him again CALL CATCH ; Eat garbage before exiting CALL ERXIT ; Yes, He doesn't need any help DB '$' ; HLPRCV: CALL ILPRT DB CR,LF,LF,LF,LF,LF 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 with Checksum' DB CR,LF DB ' KMD R 1k BATCH mode (YMODEM-type)' DB CR,LF ; IF MSGFIL DB ' KMD RM example.msg Pre-formatted message file ' DB 'upload' ENDIF ; DB CR,LF,LF,0 JMP OPTERR ; Get next option from Help Guide Menu ; HLPSND: CALL ILPRT DB CR,LF,LF,LF 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 block protocol',CR,LF DB ' KMD SB example.* 1k BATCH mode (YMODEM-type)' DB CR,LF DB ' KMD L librname example.doc Send library member file' DB CR,LF DB ' KMD LK librname example.dqc Send library member with 1k' DB CR,LF,LF,0 JMP OPTERR ; Get next option from Help Guide Menu ; HLPSPC: CALL ILPRT DB CR,LF,LF,LF,LF,LF DB 'To show how much space is available for UPLOADS enter:' DB CR,LF,LF DB ' KMD A Shows available upload space' DB CR,LF,0 JMP SPACE ; HLPINF: CALL ILPRT DB CR,LF,LF,LF,LF DB 'OTHER information - Compatibility',CR,LF,LF DB ' 1) MB-KMD provides 100% support for XMODEM protocols.' DB 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+).' DB CR,LF DB ' 3) 1k BATCH transfers are supported when using',CR,LF DB ' IMP, Yam, ProYam, or Procom v22+ (MS-DOS).',CR,LF DB CR,LF,0 JMP OPTERR ; Get next option from Help Guide Menu ; ; ============================= ; ----> SNDFL sends a CP/M 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: XRA A 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 OPTSAV CPI 'L' ; If library option skip 'CNREC' CNZ CNREC ; Ignore if in library mode 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 OPTSAV ; Get the command option again CPI 'L' JNZ SNDLP ; If not library option, exit 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 JZ SNDEOF ; If finished, exit JMP SNDLP ; ; 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 ILPRT DB CR,LF,'Calculating...',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,'Total files : ',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 ILPRT DB CR,LF,'Total records : ',0 LHLD TOTREC ; Get total records - all files PUSH H CALL DECOUT ; Show remote CALL ILPRT DB ' (',0 POP H 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 CALL DECOUT ; Show # of k CALL ILPRT DB 'k)' DB CR,LF,'Space needed : ',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 ILPRT DB 'k with 2k blocks',0 ; SBTCH1: LDA FILCNT ORA A JZ SBTCH2 LDA FSTFLG STA CONONL CALL ILPRT DB CR,LF,'Time for files: ',0 LXI H,KTABLE 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 JNZ SBTCH2 INR A ; Now show we have been this way STA FSTFLG CALL ILPRT DB CR,LF,'Ready to send - batch mode' DB CR,LF,'Abort: CTRL-X [pause] CTRL-X' DB CR,LF,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,LF,'++ 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,'[Transfer completed]',CR,LF,0 RET ; SNDABT: LDA SYSABT ORA A ; Local abort? JNZ ABORT ; Yes, else return RET ; ; =============================== ; ----> RCVFL Receive a CP/M file ; =============================== ; ; The filename specified in MB-KMD command line is transferred over the ; phone from the user's computer to the RCP/M 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 ENDIF ; IF ACCESS AND MSGFIL LDA AFBYTE ANI ACWRIT ; Test write access bye JNZ WRITOK ; No CALL ERXIT DB CR,LF,'Sorry, but you are not allowed to write messages ' DB 'at this time...','$' ENDIF ; WRITOK: IF ZCPR AND MSGFIL LDA WHEEL ORA A ; WHEEL set? JZ RCVOK4 ; No, so skip next XRA A STA WHEEL ; Turn off WHEEL CALL ILPRT DB 'The WHEEL has been turned OFF for "RM" function...',CR,LF,0 ENDIF ; IF ACCESS AND MSGFIL JMP RCVOK4 ENDIF ; RCVOK1: IF ACCESS AND PUPOPT LDA PUPFLG ORA A ; Privileged transfer option request? JZ RCVOK2 ; No LDA AFBYTE ANI ACPRIV ; Test for privileged user access (bit 7) JNZ RCVOK2 ; Yes, he's ok, skip next CALL ERXIT DB CR,LF,'You are not allowed to use the "RW" function...','$' ENDIF ; RCVOK2: ; We already checked upload access 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 CALL RCVFL1 ; Find drive/user/filetype permitted CALL CONTIN ; Display drive/user area LXI H,NAMBUF SHLD NBSAVE MVI A,1 STA FSTFLG ; No need to run those routines again ; 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 ILPRT DB 'Waiting...',0 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 CALL XFRDON ; Show transmission is finished CALL WAIT1 ; Delay to let remote get into ter. mode JMP CRED3 ; Ask for descriptions ; ; ----------------------------- ; ; Check on what drive/user area the file(s) will go into ; RCVFL1: CALL LOGDU ; Select drive/user for upload ; IF ZCPR AND 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 LDA WHEEL ; Let SYSOP put file wherever he wants ORA A JZ RCVFL5 ; If WHEEL byte not set, stay normal ; RCVFLA: 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 INR A ; Make sure it is a positive number STA RWHEEL RET ENDIF ; ZCPR ; RCVFL5: IF SETAREA 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: LDA WHEEL ; Wheel byte set for SYSOP? ORA A 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 CR,LF,'++ Select a different file extent ++','$' ENDIF ; ZCPR ; RET ; Just in case ZCPR not used, etc. ; ; Displays where the file(s) will go, opens the file and shows the name ; CONTIN: CALL ILPRT ; Print the message DB CR,LF,'File will be 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 LDA WHEEL ORA A LDA XDRV JNZ CONT2 ; WHEEL set, exit, takes next priority ENDIF ; ZCPR ; IF SETAREA LDA XDRV ; Setarea uses a specified drive ENDIF ; SETAREA ; IF NOT SETAREA LDA OLDDRV ; Otherwise get current drive ADI 'A' ; Convert to ASCII ; NOTDRV: DB 0,0 ; Filled in by 'GETDU' if requested ENDIF ; NOT SETAREA ; CONT2: STA KDRV ; Save drive for KSHOW 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 ; LOGCAL ; LDA XPRUSR ; Get private user area JMP CONT3 ; It takes priority ; NOPRVL: IF SETAREA LDA XUSR ; Setarea takes next precedence ENDIF ; SETAREA ; IF NOT SETAREA LDA OLDUSR ; Get current drive for default ; NOTUSR: DB 0,0 ; Filled in by 'GETDU' if requested ENDIF ; NOT SETAREA ; CONT3: MVI H,0 MOV L,A CALL DECOUT ; Print the user area CALL ILPRT DB ':',CR,LF,0 CALL KSHOW ; Show available space remaining CALL ILPRT DB CR,LF,LF,0 CALL CHEKFIL ; See if file exists CALL ILPRT DB 'File open - ready to receive',CR,LF DB 'Abort: CTRL-X [pause] CTRL-X',CR,LF,0 ; IF B3RTC AND (NOT MBMXT OR BYEBDOS) CALL GETTOS ; Get time on system SHLD TOSSAV ; Save it for exit ENDIF ; LDA PRVTFL ; To the private area? ORA A RNZ ; 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 ILPRT DB CR,LF,'No description - PRIVILEGED upload mode',CR,LF,0 JMP CONT6 ENDIF ; IF DESCRIB OR MSGDESC CONT5: CALL ILPRT DB CR,LF,'Description needed when done',CR,LF,0 ENDIF ; CONT6: CALL ILPRTL ; Show locally only DB 'Waiting...',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 ; 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 ; LDA BCHFLG ; In batch mode now? ORA A JNZ CRED1 ; If yes, skip following messages ; IF MSGFIL LDA MSGFLG ORA A ; Message file uploaded? JNZ CRED4 ; Yes, so skip thanks, credit and description ENDIF ; IF ACCESS AND PUPOPT LDA PUPFLG ; Get privileged transfer option flag ORA A ; Requested? JNZ CRED4 ; Else skip thanks, credit and description ENDIF ; IF ZCPR LDA WHEEL ORA A ; Sysop? JNZ CRED3 ; Yes, skip the thanks and credit ENDIF ; CRED0: CALL ILPRTB ; Show to remote also DB CR,LF,'Thank you for the upload!',CR,LF,0 ; IF B3RTC AND NOT (MBMXT OR BYEBDOS) CALL ILPRT ; And print DB CR,LF,'Time online is not increased during uploads' DB CR,LF,0 ENDIF ; IF BYEBDOS OR (B3RTC AND MBMXT) CALL ILPRT DB CR,LF,'The time you took to upload has been added' DB CR,LF,'to your remaining system time for today.' DB CR,LF,0 ENDIF ; PUSH PSW LHLD RECDNO ; Get # of records SHLD RCNT ; And stuff in RCNT CALL XTIM ; Calculate approximate transfer time POP PSW CRED1: IF 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 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 BYEBDOS AND (NOT B3RTC) LDA MAXTOS ; Get maximum time allowed ORA A JZ CRED2 ; If zero, he's a super-guy anyway INR A ADD C ; Add in upload time JC MAK254 ; Make it 254 minutes if overflow JZ MAK254 ; (or zero) CPI 255 ; (or 255) JNZ MAXSTR ; MAK254: MVI A,254 ; (254 is max allowed) ; MAXSTR: STA MAXTOS ; Save for internal use ENDIF ; CRED2: INR A ; Set to local display only STA CONONL ; ; 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 ; ; end of credit routines ; ====================== ; CRED3: IF WRTLOC AND (DESCRIB OR MSGDESC) CALL RSTLCK ; Clear WRTLOC before descriptions ENDIF ; IF DESCRIB OR MSGDESC CALL ASK ; If yes, ask for description(s) ENDIF ; CRED4: JMP DONE ; ; =============== ; WRTLOC routines ; IF WRTLOC AND NOT BYEBDOS SETLCK: CALL BYECHK ; Is BYE running RNZ ; If not, skip this LHLD 0001H ; Get JMP COLDBOOT DCX H MOV D,M DCX H MOV E,M LXI H,LOCOFF ; + LOCOFF DAD D ORI 0FFH ; = WRTLOC address MOV M,A ; Turn the lock on RET ; RSTLCK: CALL BYECHK ; Is BYE running RNZ ; 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) RET ENDIF ; IF WRTLOC AND BYEBDOS SETLCK: MVI C,BDWRTL ; Set/Get writeloc function MVI E,1 ; Turn on WRTLOC flag CALL BDOS RET ; RSTLCK: MVI C,BDWRTL ; Set/Get writeloc function MVI E,0 ; Turn off WRTLOC flag CALL BDOS RET ENDIF ; ; =================== ; 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 BLIMIT ; Received BATCH transfer limit yet? RC CALL ILPRT DB CR,LF ; Routine altered because BLIMIT must be DB '++ No more than ',0 LXI H,0 MVI A,BLIMIT MOV L,A CALL DECOUT CALL ILPRT DB ' 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 ILPRT DB 'When done: ',0 LDA SHOCNT ; Get cumulative files DCR A STA SHOCNT ; Less one MOV L,A MVI H,0 CALL DECOUT CALL ILPRT DB ' left with ',0 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 SHLD TOTREC PUSH H CALL DECOUT ; Show remote remaining records CALL ILPRT DB ' records (',0 POP H LXI D,8 CALL DVHLDE MOV A,H ORA L MOV H,B MOV L,C JZ $+4 INX H CALL DECOUT CALL ILPRT DB 'k)',CR,LF,0 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) ANI 5FH 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 ; ; end of multi-file access routine ; -------------------------------- ; ; 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 ILPRT DB CR,LF,'File name: ',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 ILPRT DB 'k)',CR,LF,'Recv time: ',0 CALL KTIM CALL OPNOK4 ; RKMD15: CALL ILPRT DB CR,LF,0 ; Finish the filename line XRA A ; Reset the carry flag STA RCVTRY ; Reset the error counter RET ; KMDCRC: CALL ILPRT DB '++ CRC error ++',CR,LF,0 JMP KMDXFR ; KMDHDR: CALL ILPRT DB '++ Wrong header type ++',CR,LF,0 JMP KMDXFR KMDTOT: CALL ILPRT DB ' ++ Time out receiving filename ++',CR,LF,0 ; KMDXFR: CALL WAIT1 ; Make sure sender has stopped 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 ; ; end of get BATCH file name ; -------------------------- ; ; 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 ; Now 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 ILPRT ; 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 ; ; end of send BATCH file name ; =========================== ; ; 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 as stored in the FCB but in CP/M format ; SHOWFIL:CALL ILPRTL ; Show on local CRT only DB CR,LF,'File name: ',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 ; IF ZCPR LDA WHEEL ; Wheel byte set for SYSOP use? ORA A JNZ TNLP3 ; If yes, let him transfer any file ENDIF ; ZCPR ; 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 LDA FCB+10 ; It is a .SYS file? ANI 80H JNZ TNLP2 ; If set, do not send ; 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 ; NOLBS OR NOCOMS ; IF NOLBS CPI '#' JZ TNLP2 ; If set, do not send ENDIF ; NOLBS ; 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 ; Stripf off any high bit set CPI 'C' JZ TNLP2 ; If yes, ignore file ENDIF ; NOCOMS ; 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: 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 ; ; ============= ; 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 ; UCASE: CPI 61H ; Changes lower case character.. RC ; In 'A'reg. 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. ; ; Go through a big search to see if BYE is active. ; IF BYEBDOS BYECHK: 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) BYECHK: LHLD 0001H ; Point to warm boot again DCX H ; If BYE active, MOV D,M ; Pick up pointer to BYE variables DCX H ; (COVECT) followed by 'BYE' MOV E,M LXI H,CONOFF ; Calculate address of BYE variable DAD D ; Where ptr to orig BIOS vector stored MOV E,M ; Load that address into DE, if BIOS INX H ; Is active, DE now points to original MOV D,M ; BIOS console output vector INX H ; Point to BYE signon message ; ; Note that if more BYE variables are added after the cold boot pointer, ; extra INX may be needed. Fix to match your BYE. ; MOV A,M ; Get letter ANI 05FH ; Convert to upper case if needed CPI 'B' ; Try to match 'BYE' RNZ ; Out if BYE not active INX H MOV A,M ANI 05FH ; Convert to upper case if needed CPI 'Y' RNZ INX H MOV A,M ANI 05FH ; Convert to upper case if needed CPI 'E' RET ENDIF ; ; 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 return to CP/M ; EXIT: IF MSGDESC LDA OPTSAV CPI 'X' JZ EXIT0 ENDIF ; IF (TIMEON OR MBYETOS) AND TOSEXIT XRA A STA CONONL ; Clear the console-only flag CALL TIME ; print time-on-system ENDIF ; EXIT0: IF WRTLOC CALL RSTLCK 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 LXI D,FCB ; Close any file(s) still open MVI C,CLOSE CALL BDOS ; EXIT2: IF BYEBDOS LDA MAXTOS ; Restore MAXTIME/status MVI C,BDSTOS MOV E,A CALL BDOS ENDIF ; XRA A ; Clear the register and carry bit LHLD STACK ; Get original return adress back SPHL ; Put on the stack pointer ; IF MSGFIL LDA MSGFLG ORA A ; Message file upload? JZ NOMSG ; No ENDIF ; IF MSGDESC LDA OPTSAV ; set on exit of message u/l descriptions CPI 'X' ; upload descripion? JZ EXIT3 ; Yes, skip following message ENDIF ; IF MSGFIL CALL ILPRTB ; Show to remote also DB CR,LF,LF,'++ Loading special message file handler ++' DB CR,LF,LF,0 ; EXIT3: 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 ; NOMSG: RET ; IF MSGFIL 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 LXI H,FCB+1 ; Stuff in filename without spaces MVI B,8 ; DESNM: MOV A,M CPI ' ' CNZ MBDPUT INX H DCR B JNZ DESNM MVI A,'.' CALL MBDPUT MVI B,3 ; DESNM3: MOV A,M CPI ' ' JZ DESGO CPI 0 JZ DESGO CALL MBDPUT INX H DCR B JNZ DESNM3 ; DESGO: MOV A,C RET ; MBDPUT: 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: IF CONFUN 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 ENDIF ; 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 LDA WHEEL ; SYSOP usig the system? ORA A LDA DUD ; Get the value back JNZ GETDU4 ENDIF ; ZCPR ; IF NOT USEMAX CPI MAXDRV JNC ILLDU ; Drive selection not available ENDIF ; NOT USEMAX ; IF USEMAX PUSH H LXI H,DRIVMAX ; Point to max drive byte INR M CMP M ; And check it PUSH PSW ; Save flags from the CMP DCR M ; Restore max drive to normal POP PSW ; Restore flags from the CPM JNC ILLDU POP H ENDIF ; USEMAX ; 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 CR,LF,'++ Batch files sent only from current D/U ++','$' ; 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 LDA WHEEL ; SYSOP using the system? ORA A LDA DUU ; Restore desired user area STA RCVUSR ; Allows SYSOP to upload anywhere JNZ OK3 ; If yes, let him have all user areas ENDIF ; ZCPR ; IF NOT USEMAX CPI MAXUSR+1 ; Check for maximum user download area JNC ILLDU ; Error if more (and not special area) ENDIF ; NOT USEMAX ; IF USEMAX PUSH H LXI H,USRMAX ; Point at maximum user byte CMP M ; And check it JNC ILLDU POP H ENDIF ; USEMAX ; OK3: MOV E,A ; IF NOT SETAREA STA NOTUSR+1 ; Store requested user area MVI A,3EH ; 'MVI A,--' instruction STA NOTUSR ENDIF ; NOT SETAREA ; MVI C,SETUSR CALL BDOS ; Set to requested user area ; OK4: LDA DUD ; Get drive MOV E,A ; IF NOT SETAREA ADI 'A' STA NOTDRV+1 ; Store requested drive MVI A,3EH ; 'MVI A,--' instruction STA NOTDRV ENDIF ; NOT SETAREA ; 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 equate is not set YES.) ; ; Print the free space remaining for the received file ; CPMVER EQU 0CH CURDPB EQU 1FH GALLOC EQU 1BH SELDSK EQU 0EH GETFRE EQU 46 ; KDRV: DB 0 ; Drive stored here before calling KSHOW ; KSHOW: LDA KDRV ; Get drive ('A','B','C',etc.) SUI 41H ; Convert to numeric (0,1,2,etc.) MOV E,A ; Stuff in E for BDOS call MVI C,SELDSK ; Select the directory drive to retrieve CALL BDOS ; The proper allocation vector MVI C,CURDPB ; It's 2.X or MP/M...request DPB CALL BDOS INX H INX H MOV A,M ; Get block shift STA BLKSHF INX H ; Bump to block mask MOV A,M INX H INX H MOV E,M ; Get max block # INX H MOV D,M XCHG SHLD BLKMAX ; Save it XCHG INX H MOV E,M ; Get directory size INX H MOV D,M XCHG ; ; Calculate # of K free on selected drive 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 ILPRT DB 'k free space is available',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 CR,LF,'++ No file name requested ++','$' ; TRERR: LDA BCHFLG ORA A RNZ ; Wildcards are ok in batch mode CALL ERXIT ; Print message, exit DB CR,LF,'++ Wild-card options are not valid ++','$' ; CKNUM: CPI '0' JC ILLDU ; Error if less than ascii '0' CPI '9'+1 RC ; Error if more than ascii '9' ; ILLDU: CALL ERXIT DB CR,LF,'++ Improper drive/user combination ++','$' ; ; Receive a record - returns with carry bit set if EOT received ; RCVRECD:XRA A ; Initialize error count to zero STA ERRCT ; RCVRPT: 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 ILPRT 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 ILPRT DB CR,LF,LF,'++ RECEIVED FILE CANCELLED ++',0 CALL DELFILE ; Delete received file CALL ERXIT ; Print second half of message DB '++ UNFINISHED FILE 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 ERXIT ; No, abort DB CR,LF,'++ Can''t delete received file ++','$' ; ; 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: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: 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 ILPRT DB 'H',0 JMP GTACK5 ; GTACK4: CALL ILPRT DB 'NAK',0 ; GTACK5: CALL ILPRT 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,'++ FILE TRANSFER ABORTED ++','$' ; ; Timed out, with no character - set the carry bit and return ; GTATOT: CALL ILPRT 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 ILPRT DB CR,LF,'Aborting 1k blocks, too many hits',CR,LF,0 RET ; CKABORT: IF NOT CONFUN RET ENDIF ; IF CONFUN CALL 0000H ORA A RZ ; CKABRT: CALL 0000H CPI CANCEL RNZ ENDIF ;CONFUN ; ; 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: MVI A,0 STA CONONL CALL CATCH CALL ERXIT1 ; Exit with abort message DB CR,LF,' ++ MB-KMD ABORTED ++','$' ; ; 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:LHLD RECDNO ; Get the record number for display LDA OPTSAV ; See if receive or send mode CPI 'R' JZ RMSG CALL ILPRTL ; Show locally only DB CR,'Sending # ',0 JMP REST ; RMSG: CALL ILPRTL ; Show locally only DB CR,'Received # ',0 ; REST: LHLD RECDNO CALL DECOUT CALL ILPRT 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 LDA PRVTFL ; Receiving in private area? ORA A CNZ RECAREA ; If yes, set drive and user area ENDIF ; NOT SETAREA ; IF SETAREA CALL RECAREA ; Set the designated area up ENDIF ; SETAREA ; 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 CR,LF,'++ File exists, use a different name ++','$' ; ; Makes the file to be received ; MAKEFIL:XRA A ; Set extent and record number to 0 STA FCBEXT STA FCBRNO ; IF HIDEIT AND ZCPR LDA WHEEL ORA A JNZ NOTSYS ; Don't make it $SYS if SYSOP online ENDIF ; IF HIDEIT 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 ENDIF ; HIDEIT ; NOTSYS: 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 CR,LF,'++ Error: can''t make file -' DB ' directory may be 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 ; ; ============= ; ; Opens the file to be sent ; OPNFIL: XRA A ; Set extent and rec number to 0 STA FCBEXT ; For proper open STA FCBRNO MVI C,OPEN ; Get function LXI D,FCB ; Point to file CALL BDOS ; Open it INR A ; Open ok? JNZ OPNOK ; If yes, exit LDA OPTSAV ; Get command line option CPI 'L' ; Want to send a library file? JNZ NONAME ; Exit, if not CALL ERXIT DB CR,LF,'++ No .LBR file with that name ++','$' ; NONAME: CALL ERXIT DB CR,LF,'++ No file with that name ++','$' ; ZEROLN: CALL ERXIT DB CR,LF,'++ File is empty, MB-KMD aborted ++','$' ; OPNOK: IF ZCPR LDA WHEEL ; Check wheel status if ZCPR ORA A ; Is it zero JNZ OPNOK1 ; If non-zero skip all restrictions ENDIF ; ZCPR ; IF TAGFIL LDA OPTSAV ; Sending a file now? CPI 'S' ; If using 'L' let them alone JNZ OPNOK0 ; If using 'S' check for tags 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 CR,LF,'++ File is not for distribution, sorry. ++','$' ; OPNOT1: CALL ERXIT ; Exit with message DB CR,LF,'++ Only individual library member files may be ' DB 'transferred ++','$' ; OPNOK1: LDA BCHFLG ; Requesting batch mode? ORA A JNZ OPNOK2 ; If yes, skip library stuff LDA OPTSAV ; Get the primary option back CPI 'L' ; Asking for library member file? JNZ OPNOK2 ; If not, exit 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 LHLD 8EH SHLD DIRSIZ LXI H,TBUF MOV A,M ORA A JZ CKDIR ; Check directory present? ; NOTLBR: CALL ERXIT DB CR,LF,'++ No .LBR file with that name ++','$' ; ; 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 CALL ERXIT DB CR,LF,'++ Requested file not found in the .LBR ++','$' ; 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 ; OPNOK2: IF ZCPR LDA WHEEL ; Check status of wheel if ZCPR ORA A ; Is it set? JNZ OPNOK3 ; If yes, skip the # and .COM check ENDIF ; ZCPR ; 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 CR,LF,'++ Can''t Send a .COM File ++','$' ENDIF ; NOCOMS ; OPNOK3: CALL ILPRT ; Print the message DB CR,LF,LF,'File open: ',0 LHLD RCNT ; Get record count CALL DECOUT ; Print decimal number of records PUSH H CALL ILPRT DB ' records (',0 POP H ; Get # of 128 byte records MOV A,H ORA L JZ ZEROLN ; Can't send 0-length files LXI D,8 ; Divide by 8 CALL DVHLDE ; To get # of 1024 byte blocks MOV A,H ORA L ; Check if remainder MOV H,B ; Get quotient MOV L,C JZ $+4 ; If 0 remainder, exact kilobytes INX H ; Else, increment to next k CALL DECOUT ; Show # of kilobytes LDA SNDFLG ; Receiveing batch mode now? ORA A RNZ ; If yes, all done ; ; Show transfer time, first for 1k blocks, then for 128 (skip the 1k ; times for slower than 1200 bps.)for 1200 bps ; CALL ILPRT DB 'k)',CR,LF DB 'Send time: ',0 LDA MSPEED CPI MINKSPD ; See if we are below the minimum 1k speed JC XMDSPD ; Skip 1k speed if so ; KMDSPD: CALL KTIM ; Get file transfer time in BC (minutes) CALL STORTIM ; Store for comparing time remaining CALL OPNOK4 CALL ILPRT DB ' - 1k size',CR,LF DB 'Send time: ',0 ; XMDSPD: 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 ' - 128 size',CR,LF,0 LDA BCHFLG ORA A CNZ CUMSTS ; Show how many files remain after this LDA FSTFLG ORA A RNZ CALL ILPRT DB CR,LF,'File open -- ready to send' DB CR,LF,'Abort: CTRL-X [pause] CTRL-X',CR,LF,0 RET ; OPNOK4: PUSH H ; Save seconds in 'L' ; IF ZCPR AND MAXTIM LDA WHEEL ; Check wheel status if ZCPR ORA A ; Is it zero JNZ SKPTIM ; If its not then skip the limit ENDIF ; ZCPR ; 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 ZCPR AND MAXTIM LDA WHEEL ; Check wheel status if zcpr2 ORA A ; Is it zero JNZ SKIPEM ; If not then no time limits ENDIF ; IF MAXTIM AND (BYEBDOS OR MXTOS) LDA MAXTOS ; Get maximum time on system ORA A ; If zero, this guy is a winner JZ SKIPEM ; (skip restrictions) LDA MINUTE+1 ; Is it over 255 minutes? ORA A JNZ OVERTM ENDIF ; IF MTL CALL GETTOS ; Get time on system in HL ENDIF ; IF MAXTIM AND (BYEBDOS OR MXTOS) LDA MAXTOS INR A ENDIF ; IF MTL SUB L ; Get how much time is left ADI MAXMIN ; Give them MAXMIN extra ENDIF ; IF MAXTIM AND (BYEBDOS OR MXTOS) MOV B,A ; Put max time on sys in B LDA MINUTE ; Are we > max time on sys? CMP B JNC OVERTM ENDIF ; IF MAXTIM AND NOT (BYEBDOS OR MXTOS) LDA MINUTE+1 ; Get minute count high byte ORA A ; Check if zero JNZ OVERTM ; If not, is over 255 minutes! LDA MINUTE ; Get minute count CPI MAXMIN+1 ; Compare to MAXTIM value JNC OVERTM ; If greater than MAXTIM ENDIF ; SKIPEM: RET ; IF MAXTIM OVERTM: CALL ILPRT DB CR,LF,LF,' ++ MB-KMD ABORTED ++',CR,LF,LF DB 'Required send time exceeds the ',0 ENDIF ; IF MAXTIM AND NOT (BYEBDOS OR MXTOS) LXI H,0 LDA TON MOV B,A MVI A,MAXMIN SUB B MOV L,A ENDIF ; IF MTL CALL GETTOS ; Get TOS back into HL ENDIF ; IF MAXTIM AND (BYEBDOS OR MXTOS) LDA TLOS ENDIF ; IF MTL SUB L ; Get time left ADI MAXMIN ; Add MAXMIN ENDIF ; IF MAXTIM AND (BYEBDOS OR MXTOS) MVI H,0 MOV L,A ENDIF ; IF MAXTIM CALL DECOUT CALL ERXIT1 DB ' minutes remaining','$' ENDIF ; IF NOT STOPBIT ; One stop bit 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 ENDIF ; IF STOPBIT ; Two stop bits XTABLE: DW 5,12,18,23,27,44,78,128,191,255,0 KTABLE: DW 5,13,19,25,29,48,92,173,300,477,0 XECTBL: DB 192,80,53,42,36,22,12,7,5,4,0 KECTBL: DB 192,74,51,38,33,20,10,6,3,2,0 ENDIF ; SPTBL: DB '110$','300$','450$','600$','710$','120$','240$' DB '480$','960$','1920$' ; ; Pass record count in RCNT: returns file's approximate download/upload ; time in minutes in BC, seconds in '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 ; LOGCAL ; RET ; End of FILTIM routine ; ; Divides 'HL' by value in 'DE' - upon exit: BC=quotient, HL=remainder ; DVHLDE: PUSH D ; Save divisor MOV A,E CMA ; Negate divisor MOV E,A MOV A,D CMA MOV D,A INX D ; 'DE' is now two's complemented LXI B,0 ; Init quotient ; DIVL1: DAD D ; Subtract divisor from divident INX B ; Bump quotient JC DIVL1 ; Loop until sign changes DCX B ; Adjust quotient POP D ; Retrieve divisor DAD D ; Readjust remainder RET ; ; Multiply 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 ILPRT DB '0',0 RET ; ; end of open file, set time routine ; ================================== ; ; Closes 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 CR,LF,'++ Can''t close the file ++','$' ; ; 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 MVI C,STDMA ; Set DMA address CALL BDOS MVI C,READ LXI D,FCB CALL BDOS 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 ; ; Read error ; RDERR: CALL ERXIT DB CR,LF,'++ 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 CR,LF,'++ 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,LF,LF,'++ Carrier lost ++',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 ; ; ============= ; ; Description routines ; ASK: IF DESCRIB OR MSGDESC LDA OPTSAV ; Get the option CPI 'R' RNZ ; If not receiving a file, exit LDA PRVTFL ; Sending to "private area"? ORA A RNZ ; If yes, do not ask for description ENDIF ; IF (DESCRIB OR MSGDESC) AND (ACCESS AND PUPOPT) LDA PUPFLG ; Get privileged status ORA A ; Privileged transfer request? RNZ ; Yes, skip description ENDIF ; IF MSGDESC LXI D,FILE ; Let's delete the FOR. file for now. MVI C,DELET ; Otherwise previous upload descriptions CALL BDOS ; will be appended also. 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 CALL SHONM ; Show the file name CALL DILPRT DB ' - this file is for:',CR,LF,LF,0 MVI C,PRINT ; Display the file descriptors LXI D,KIND0 CALL BDOS CALL DILPRT DB CR,LF,'Select a category: ',0 CALL INPUT ; Get a character CALL TYPE CPI '0' JC ASK1 CPI '9'+1 JNC ASK1 STA KIND ENDIF ; IF DESCRIB AND (NOT ASKIND) ASK1: CALL DELAY CALL SHONM ENDIF ; IF WRAPOPT AND (DESCRIB OR MSGDESC) ASK2: 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 ' DB 'wish to turn off wrap',CR,LF DB 'during each description text transfer, answer es.' DB CR,LF,LF DB 'Turn off automatic end-of-line wrap? ',0 CALL INPUT ANI 5FH ; Change to upper case CPI 'Y' ; Turn off wrap mode? JNZ ASK2A ; No CALL DILPRT ; ...else DB 'Yes',CR,LF,'(Automatic wrap mode is now OFF)',0 MVI A,70 STA XWRAP ; Turn off wrap mode JMP ASK3 ; Ask for description ; ASK2A: CALL DILPRT DB 'No',CR,LF,'(Automatic wrap mode is now ON)',0 ENDIF ; IF DESCRIB OR MSGDESC ASK3: 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 ENDIF ; ; Get the file name from FCB, skip any blanks ; IF DESCRIB LXI H,HLINE ; Store short line with dashes CALL DSTOR1 ; Store and show CALL ASK3A JMP AFIND1 ENDIF ; IF MSGDESC LXI H,DMSG ; 'Msg#: ????' CALL DSTOR1 LXI H,DFROM ; 'From: ' CALL DSTOR1 LXI H,DTO ; ' To: ' CALL DSTOR1 ; LXI H,DRE+18 ; Now we build the ' Re: NEW UPLOAD' line LDA XDRV ; Already ASCII MOV M,A INX H LDA XUSR ; Convert binary USER to DECIMAL. CALL DEC8 ; Store the user area of upload INX H ; Point to character after decimal User Area MVI A,':' MOV M,A ; Store a colon INX H LXI D,FCB+1 CALL ASK3B ; Go get the filename MVI A,CR MOV M,A INX H MVI A,LF MOV M,A ; LXI H,DRE ; No store the line we just made: CALL DSTOR1 ; ' Re: NEW UPLOAD: duu:filename.ext',CR,LF ; MVI A,CR ; MBBS requires a blank line between CALL OUTCHR ; the message header and the actual MVI A,LF ; message text. CALL OUTCHR JMP NOKIND ENDIF ; IF DESCRIB OR MSGDESC ASK3A: LXI D,FCB+1 LXI H,OLINE ; ASK3B: MVI B,8 ; Get FILENAME CALL LOPFCB LDAX D CPI ' ' ; Any file extent? RZ MVI A,'.' MOV M,A ; Separate FILENAME and EXTENT CALL TYPE INX H MVI B,3 ; Get EXTENT name CALL LOPFCB RET ENDIF ; AFIND1: IF DESCRIB AND ASKIND LDA KIND CPI '0' LXI D,KIND0+4 CZ DKIND ; File category 0 CPI '1' LXI D,KIND1+4 CZ DKIND ; File category 1 CPI '2' LXI D,KIND2+4 CZ DKIND ; File category 2 CPI '3' LXI D,KIND3+4 CZ DKIND ; File category 3 CPI '4' LXI D,KIND4+4 CZ DKIND ; File category 4 CPI '5' LXI D,KIND5+4 CZ DKIND ; File category 5 CPI '6' LXI D,KIND6+4 CZ DKIND ; File category 6 CPI '7' LXI D,KIND7+4 CZ DKIND ; File category 7 CPI '8' LXI D,KIND8+4 CZ DKIND ; File category 8 CPI '9' LXI D,KIND9+4 CZ DKIND ; File category 9 ENDIF ; IF DESCRIB ; Take off c/r (put back after date whether DCX H ; or not datestamping is done) ENDIF IF (RTC OR B3RTC OR BYEBDOS) AND ASKIND AND DESCRIB AND DSTAMP CALL DATPUT ; Add ' Rcvd: ' and display it 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 CALL TYPE INX H POP PSW ; Get DD/YY PUSH PSW ; Save YY CALL DATDEC ; Print DD MVI A,'/' ; '/' MOV M,A CALL TYPE INX H POP B ; Get YY MOV A,C CALL DATDEC ; Print YY JMP GOTDAT ; 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 MOV M,A CALL TYPE INX H MOV A,B ADI '0' MOV M,A CALL TYPE INX H ; point at next open byte in buffer POP D POP B RET ; DATPUT: PUSH D ; put Rcvd msg in mem buffer and display it LXI D,DATMSG ; DATPT1: LDAX D CPI 0 JZ DATPT2 MOV M,A CALL TYPE INX H INX D JMP DATPT1 ; DATPT2: POP D RET ; DATMSG: DB ' Rcvd: ',0 ; GOTDAT: ENDIF ; IF DESCRIB MVI M,CR INX H MVI M,LF CALL DSTOR ENDIF ; IF DESCRIB OR MSGDESC NOKIND: CALL DILPRT DB CR,LF,' <----------------------( maximum' DB ' line length )---------------------->',CR,LF,0 ; AFIND2: XRA A STA ANYET ; Reset the flag for no information yet 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 CALL TYPE ; Nope, print line number MVI A,' ' CALL OUTCHR CALL OUTCHR CALL OUTCHR CALL DILPRT DB '> ',0 CALL DESC ; Get a line of information CALL DSTOR JMP EXPLN ; EXPL1: MVI A,CR ; All finished, put in an extra CR-LF CALL OUTCHR MVI A,LF CALL OUTCHR MVI A,'$' CALL OUTCHR CALL DILPRT DB CR,LF,' Here''s what you wrote:',CR,LF,LF,0 LHLD BUFADR ; Get starting address of description XCHG ENDIF ; IF MSGDESC 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 INX D ; Increment pointer CALL SHONM ; Show the filename CALL DILPRT DB CR,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 ANI 5FH ; Change to upper case CALL TYPE ; Display answer CPI 'Y' JZ EXPL4 ; Exit if this description was ok ; EXPL3: LHLD BCHPTR ; Else restart at beginning of text SHLD OUTPTR ; Start over at this address JMP ASK3 ; 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 ENDIF ; ; Set drive/user to the area listed above ; IF DESCRIB MVI C,SETUSR MVI E,USER ; Set user to FOR file user area CALL BDOS MVI A,DRIVE ; Set drive to FOR file drive SUI 41H MVI C,SELDSK MOV E,A CALL BDOS ENDIF ; IF MSGDESC MVI A,PRUSR STA USRSAV MOV E,A MVI C,SETUSR CALL BDOS ; Set private upload user for msg descrips ; MVI A,PRDRV SUI 'A' STA DSKSAV MOV E,A MVI C,SELDSK CALL BDOS ; Set private upload drive for msg descrips ENDIF ; ; Open source file ; IF DESCRIB OR MSGDESC CALL DILPRT DB CR,LF,0 LXI D,FILE ; Open FOR text file MVI C,OPEN CALL BDOS INR A ; Check for no open JNZ OFILE ; File exists, exit MVI C,MAKE ; None exists, make a new file LXI D,FILE CALL BDOS INR A JZ NOROOM ; Exit if cannot open new file ; OFILE: LXI H,FILE ; Otherwise use same filename LXI D,DEST ; With .$$$ extent for now MVI B,9 CALL MOVE ; ; Open the destination file ; XRA A STA DEST+12 STA DEST+32 LXI H,BSIZE ; Get Buffer allocated size SHLD OUTSIZ ; Set for comparison MVI C,DELET ; Delete any existing file that name LXI D,DEST CALL BDOS MVI C,MAKE ; Now make a new file that name LXI D,DEST CALL BDOS INR A JZ NOROOM ; Cannot open file, no directory room CALL DILPRT DB CR,LF,'Writing description to file...',CR,LF,0 ENDIF ; IF MSGDESC CALL DILPRT DB CR,LF,'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 70 ; 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 70 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 DKIND: LDAX D ; Get the character from the string ENDIF ; IF DESCRIB AND ASKIND AND DSTAMP CPI CR JZ DKIND0 CPI LF JZ DKIND0 ENDIF ; IF DESCRIB AND ASKIND CALL TYPE ; Otherwise display the character ; DKIND0: MOV M,A ; Put in the buffer CPI LF ; Done yet? JZ DKIND1 ; Exit if a LF, done INX D ; Next position in the string INX H ; Next postion in the buffer JMP DKIND ; Keep going until a LF ; DKIND1: LDA KIND ; Get the kind of file back RET ; Finished ENDIF ; IF DESCRIB OR MSGDESC DSTOR: LXI H,OLINE ; DSTOR1: MOV A,M CALL OUTCHR CPI LF RZ INX H JMP DSTOR1 ; ; Disk is full, save original file, erase others. ; FULL: MVI C,DELET LXI D,DEST CALL BDOS JMP DEXIT DB CR,LF,'++ DISK FULL, aborting, saving original file ++','$' ; ; Get a character, if none ready wait up to 2 minutes, then abort pgm ; 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*100 ; 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 MVI A,CR CALL OUTCHR MVI A,LF CALL OUTCHR LXI SP,STACK ; Restore the stack CALL EXPL5 ; Finish appending previous information JMP EXIT ; Finished ; INPUT4: POP B POP D POP H RET ; ; Stores the Filename/extent in the buffer temporarily ; LOPFCB: LDAX D ; Get FCB FILENAME/EXT character CPI ' '+1 ; 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 CR,LF,'++ NO DIR SPACE: OUTPUT ++','$' ; ; Output error - cannot close destination file ; OERROR: JMP DEXIT DB CR,LF,'++ CANNOT CLOSE 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 ENDIF ; IF MSGDESC LXI D,FILE ENDIF ; IF DESCRIB LXI D,DEST ENDIF ; IF DESCRIB OR MSGDESC 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 ENDIF ; IF MSGDESC LXI D,FILE ENDIF ; IF DESCRIB LXI D,DEST ENDIF ; IF DESCRIB OR MSGDESC CALL BDOS CALL DEXIT DB '++ SOURCE FILE READ ERROR ++$' ; ; Reset the Drive/User to original ; RESET: 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 ; ; 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 ; ; Shows the Filename/extent ; SHONM: CALL DILPRT DB CR,LF,LF,0 LXI H,FCB+1 MVI B,8 ; Maximum size of file name CALL SHONM1 MOV A,M ; Get the next character CPI ' ' ; Any file extent? RZ ; If not, finished MVI A,'.' CALL TYPE MVI B,3 ; Maximum size of file extent ; SHONM1: MOV A,M ; Get FCB FILENAME/EXT character CPI ' '+1 ; Skip any blanks JC $+6 CALL TYPE ; Display on CRT INX H ; Next FCB position DCR B ; One less to go JNZ SHONM1 ; If not done, get next one RET ; ; Transfer is done - close destination file ; TDONE: LHLD OUTPTR MOV A,L ANI RLEN-1 JNZ TDONE1 SHLD OUTSIZ ; TDONE1: MVI A,EOF ; Fill remainder of record with ^Z's PUSH PSW CALL OUTCHR POP PSW JNZ TDONE MVI C,CLOSE ; Close FOR text file LXI D,FILE CALL BDOS ENDIF ; IF DESCRIB 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 ; IF MSGDESC LXI H,FILE+1 LXI D,FCB+1 MVI B,16 CALL MOVE MVI A,'X' ; Indicate message system u/l description STA OPTSAV MVI A,1 ; Set MSGFLG before exiting STA MSGFLG JMP EXIT ; Go append the message base ENDIF ; ; Send character in 'A' register to console ; IF DESCRIB OR MSGDESC 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 ; ; 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 - to ensure no data is sent until the receiving ; program is ready, this routine waits for the first timeout-nak or the ; letter 'C' for CRC from the receiver. If CRC is in effect then Cyclic ; Redundancy Checks are used instead of checksums. 'E' contains the ; number of seconds to wait. If the first character received is 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 CR,LF,'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 ILPRT DB CR,LF,'1k 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 ILPRT DB CR,LF,'Checksum requested',CR,LF,0 RET ; From WAITNAK ; SETNAK1:CALL ILPRT DB CR,LF,'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 'L' RNZ ; If not, finished ; ; Handles library entries, first checks for proper .LBR extent. If no ; extent was included, it adds one itself. ; SHLD SAVEHL LXI H,FCB+9 ; 1st extent character MOV A,M CPI ' ' JZ NOEXT ; No extent, make one CPI 'L' ; Check 1st character in extent JNZ LBRERR INX H MOV A,M CPI 'B' ; Check 2nd character in extent JNZ LBRERR INX H MOV A,M CPI 'R' ; Check 3rd character in extent JNZ LBRERR ; ; Get the name of the desired file in the library ; MOVEF1: LHLD SAVEHL ; Get current position on command line CALL CHKMSP ; See if valid library member file name INR B ; Increment for move name LXI D,MEMFCB ; Store member name in special buffer JMP MOVENAM ; Move from command line to buffer, done ; ; Check for any spaces prior to library member file name, if none (or ; only spaces remaining), no name. ; CHKMSP: DCR B JZ MEMERR MOV A,M CPI ' '+1 RNC INX H JMP CHKMSP ; ; Gets the count of characters remaining on the command line ; GETB: MOV A,L SUI TBUF+2 ; Start location of 1st command MOV B,A ; Store for now LDA TBUF ; Find length of command line SUB B ; Subtract those already used MOV B,A ; Now have number of bytes remaining RET ; LBRERR: CALL ERXIT DB CR,LF,'++ Invalid library name ++','$' ; MEMERR: CALL ILPRT DB CR,LF,LF,'++ No library member file requested ++' DB CR,LF,0 JMP OPTERR ; ; Add .LBR extent to the library file name ; NOEXT: LXI H,FCB+9 ; Location of extent MVI M,'L' INX H MVI M,'B' INX H MVI M,'R' JMP MOVEF1 ; Now get the library member name ; ; Move a file name from the 'TBUF' command line buffer into FCB ; MOVENAM:MVI C,1 ; MOVEN1: MOV A,M CPI ' '+1 ; Name ends with space or return JC FILLSP ; Fill with spaces if needed CPI '.' JZ CHKFIL ; File name might be less than 8 chars. STAX D ; Store INX D ; Next position to store the character INR C ; One less to go MOV A,C CPI 12+1 JNC NONAME ; 11 chars. maximum filename plus extent ; MOVEN2: INX H ; Next char. in file name DCR B JZ OPTERR ; End of name, see if done yet JMP MOVEN1 ; ; See if any spaces needed between file name and .ext ; CHKFIL: CALL FILLSP ; Fill with spaces JMP MOVEN2 ; FILLSP: MOV A,C CPI 9 RNC ; Up to 1st character in .ext now MVI A,' ' ; Be sure there is a blank there now STAX D INR C INX D JMP FILLSP ; Go do another ; CTYPE: PUSH B ; Save all registers PUSH D PUSH H MOV E,A ; Character to 'E' in case BDOS (normal) LDA CONONL ; Want to bypass 'BYE' output to modem? ORA A JNZ CTYPEL ; Yes, go directly to CRT, then MVI C,WRCON ; BDOS console output, to CRT and modem CALL BDOS ; Since 'BYE' intercepts the char. POP H ; Restore all registers POP D POP B RET ; CTYPEL: MOV C,E ; BIOS needs it in 'C' CALL CONOUT ; BIOS console output routine, not BDOS POP H ; Restore all registers saved by 'CTYPE' POP D POP B RET ; ; 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 ; ; Exit printing message following call ; ERXIT: CALL ILPRT 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 ILPRT 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 ; ; =============== ; 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 ; ; end of CRC routines ; =================== ; ; Start of LOGCAL routines ; ; Main log file routine, adds record to log file ; IF LOGCAL LOGCALL: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 '++ NO LASTCALR???' ; ERROR msg, then go send EOT DB ' FILE FOUND ++',0 RET ; 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 (RTC OR B3RTC OR BYEBDOS) 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 '++ NO DIR 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 OPTSAV CPI 'L' JNZ WDRV1 LXI H,MEMFCB ; Name of file in library MVI B,11 CALL PUTSTR CALL PUTSP ; ' ' ; WDRV1: LXI H,FCB+1 ; Now the name of the file MVI B,11 CALL PUTSTR LDA OPTSAV CPI 'L' JNZ WDRV2 MVI C,1 JMP SPLOOP ; WDRV2: MVI C,13 ; SPLOOP: PUSH B CALL PUTSP ; Put ' ' POP B DCR C JNZ SPLOOP LHLD RECDNO ; Get record count LXI D,8 ; Divide record count by 8 CALL DVHLDE ; To get # of 1024 byte blocks MOV A,H ORA L ; Check if remainder MOV H,B ; Get quotient MOV L,C JZ EXKB2 ; If 0 remainder, exact kb INX H ; Else increment to next kb ; EXKB2: CALL PNDEC3 ; Print to log file (right just xxxk) LXI H,LOGK ; 'k ' MVI B,2 CALL PUTSTR ENDIF ; LOGCAL ; IF LOGCAL AND (B3RTC OR RTC OR BYEBDOS) XRA A STA COMMA ; Reset field counter CALL GETDATE ; IF RTC, get current date PUSH B ; (save DD/YY) CALL PNDEC ; Print MM MVI A,'/' ; '/' CALL PUTLOG POP PSW ; Get DD/YY PUSH PSW ; Save YY CALL PNDEC ; Print DD MVI A,'/' ; '/' CALL PUTLOG POP B ; Get YY MOV A,C CALL PNDEC ; Print YY CALL PUTSP ; ' ' CALL GETTIME ; IF RTC, get current time STA MNSAV ; Save min MOV A,B ; Get current hour CALL PNDEC ; Print hr to file MVI A,':' ; With ':' CALL PUTLOG ; Between HH:MM LDA MNSAV ; Get min CALL PNDEC ; And print min CALL PUTSP ; Print a space ENDIF ; IF LOGCAL 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 ENDIF ; LOGCAL ; CLOP1: IF LOGCAL CPI ' ' ; Space? JNZ CLOP1A ; No, check for comma MVI A,',' ; Convert space to comma for field checking ENDIF ; IF LOGCAL CLOP1A: CPI ',' ; Comma? JNZ CLOP2 ENDIF ; LOGCAL ; IF LOGCAL 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 ENDIF ; IF LOGCAL 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 '++ CANNOT CLOSE LOG ++',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 '++ DISK FULL - CANNOT 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 ADI '0' CALL PUTLOG POP H POP D POP B RET ; ; Put string to log file ; PUTSTR: MOV A,M PUSH H PUSH B CALL PUTLOG POP B POP H INX H DCR B JNZ PUTSTR RET ENDIF ; LOGCAL ; ; end of LOGCAL routines ; ====================== ; ; Start of TIMEON routine ; ; 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-hour-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,BDGRTC 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 ZCPR AND (TIMEON OR BYEBDOS) LDA WHEEL ; Check wheel status if ZCPR ORA A ; Is it zero JNZ TIME3 ; If not then this is a special user ENDIF ; IF TIMEON OR BYEBDOS LDA MAXTOS ORA A ; If maxtos is zero, guy is superuser JZ TIME3 ENDIF ; IF TIMEON AND NOT BYEBDOS ; BYEBDOS doesn't use status byte 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 ILPRT ; MSG1: DB CR,LF,'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 ILPRT DB CR,LF,CR,LF DB 'Your time is up - wait 24 hours to call back',CR,LF,0 RET ; TON: DB 0 ; TON will always be 0 if TIMEON is NO TLOS: DB 0 ; Storage for time left on system CMTEMP: DB 0 ; Storage for current minute value ENDIF ; TIMEON OR BYEBDOS ; ; Get caller's time on system from BYE3 or MBYE and display on console. ; IF B3RTC AND MBYETOS TIME: CALL ILPRT DB CR,LF,'Time on system is ',0 CALL GETTOS ; Get Time On System from MBYE's RTC CALL DECOUT ; Print it on the screen CALL ILPRT DB ' minutes',CR,LF,0 RET ENDIF ; ; Get caller's time on system (returned in HL). ; IF B3RTC AND (NOT BYEBDOS) GETTOS: LHLD RTCBUF ; Get RTCBUF addr MOV A,M ; If hours = 99 CPI 099H LXI H,0 RZ ; Return with TOS=0 LHLD RTCBUF LXI D,B3CMOS ; Get offset to TOS word DAD D ; (addr in HL) MOV E,M ; Get minutes on system INX H MOV D,M ; Stuff into DE XCHG ; Swap into HL RET ENDIF ; IF BYEBDOS OR MXTOS OR MAXTIM MAXTOS: DB 0 ; Maximum time on system ENDIF ; ; end of TIME 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 ; YEAR: DB 0 MONTH: DB 0 DAY: DB 0 ENDIF ; RTC AND LOGCAL AND CPM3 ; ; ============= ; IF LOGCAL AND B3RTC AND NOT BYEBDOS CALL BYECHK ; See if BYE is running JZ GETBDAT ; If so, get date from buffer & convert MVI A,0 ; Else, return 00/00/00 MOV B,A MOV C,A RET ENDIF ; IF LOGCAL AND B3RTC AND (NOT BYEBDOS) GETBDAT:LHLD RTCBUF ; Get RTC buffer in HL ENDIF ; IF LOGCAL AND BYEBDOS AND (NOT B3RTC) MVI C,BDGRTC ; Get RTC buffer in HL CALL BDOS ENDIF ; IF LOGCAL AND (BYEBDOS OR B3RTC) LXI D,4 ; Offset to YY DAD D ; HL=YY Address MOV A,M ; Get YY CALL BCDBIN ; Make it binary STA YYSAV ; Save YY INX H ; Point to MM MOV A,M ; Get MM CALL BCDBIN ; Convert BCD to binary STA MMSAV ; Save it INX H ; Point to DD MOV A,M ; Get DAY CALL BCDBIN ; Convert it to binary MOV B,A ; Stuff DD in B LDA YYSAV ; Get YY MOV C,A ; Put YY in C LDA MMSAV ; Get MM in A RET ; And return ENDIF ; ; The routine here should read your real-time clock and return with the ; following information: ; ; register: A - current minute (0-59) ; B - current hour (0-23) ; GETTIME: IF (TIMEON OR RTC) AND NOT (B3RTC OR CPM3 OR BYEBDOS) ; ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;; (this example is for the Serria SBC-100) ;; ;;SBCHR EQU 040H ; Low memory area where stored ;;SBCMN EQU 041H ;; ;; LDA SBCHR ; Get hour from BIOS memory-clock ;; MOV B,A ;; LDA SBCMN ; Get minute from BIOS memory-clock ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;; (this example is for Don Brown's computer) ;; ;; LDA 43h ; Get the current binary hour number ;; MOV B,A ; Set to return binary hour number in Reg. B ;; LDA 42h ; Get the current binary minute number ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; RET ENDIF ; ; The following code is for CP/M Plus ; IF (TIMEON OR RTC) AND CPM3 MVI C,GETTIM ; BDOS function to get date and time LXI D,TIMEPB ; Get address of 4-byte data structure CALL BDOS ; Transfer the current date/time LDA TIMEPB+2 ; Get current hour CALL BCDBIN ; Convert BCD hour to binary MOV B,A ; Position hour for return PUSH B ; Save the binary hour LDA TIMEPB+3 ; Get current minute CALL BCDBIN ; Convert BCD minute to binary POP B ; Restore the binary hour RET ENDIF ; IF LOGCAL AND B3RTC AND (NOT BYEBDOS) CALL BYECHK ; See if BYE is running JZ GETBTIM ; If so, get time from buffer & convert MVI A,0 ; Else, return 00:00 MOV B,A RET ; GETBTIM:LHLD RTCBUF ; Get RTC buffer address ENDIF ; IF LOGCAL AND BYEBDOS AND (NOT B3RTC) MVI C,BDGRTC ; Get RTC buffer address CALL BDOS ENDIF ; IF LOGCAL AND (B3RTC OR BYEBDOS) MOV A,M ; Get hours on system CALL BCDBIN ; Convert BCD value to binary PUSH PSW ; Save hr on stack INX H ; Point to minute MOV A,M ; Get min CALL BCDBIN ; Convert BCD to binary POP B ; Get hr in B (min in A) RET ; And return ENDIF ; ; Convert BCD value in A to binary in A ; IF LOGCAL AND (B3RTC OR CPM3 OR BYEBDOS) BCDBIN: PUSH PSW ; Save A ANI 0F0H ; Mask high nibble RRC ; Move to low nibble RRC RRC RRC MOV C,A ; And stuff in C (C=A) MVI B,9 ; X10 (*9) ; BCDBL: ADD C ; Add orig value to A DCR B ; Decrement B JNZ BCDBL ; Loop nine times (A+(C*9)=A*10) MOV B,A ; Save result in B POP PSW ; Get original value ANI 0FH ; Mask low nibble ADD B ; +B gives binary value of BCD digit A RET ; Return ENDIF ; ; Check to see that HL register is at least 8 records. If 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,BDCONO ; 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,BDMOUT CALL BDOS POP H POP D POP B RET ; GETCHR: MDINP: PUSH B PUSH D PUSH H MVI C,BDMINP CALL BDOS POP H POP D POP B RET ; ; The following 3 routines operate in differently than BYE does, so we ; must make things "backwards" ; MDCARCK:PUSH B PUSH D PUSH H MVI C,BDCSTA CALL BDOS JMP BKWDS ; MDINST: PUSH B PUSH D PUSH H MVI C,BDMIST CALL BDOS JMP BKWDS ; MDOUTST:PUSH B PUSH D PUSH H MVI C,BDMOST CALL BDOS ; ; Flip around bytes, if A>0 then make A zero & set flags ; if A=0 then make A =255 & set flags BKWDS: ORA A MVI A,255 JZ NOSIG XRA A ; NOSIG: ORA A POP H POP D POP B RET ; SPEED: LDA MSPEED RET ENDIF ; ; ============= ; ; 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 minutes and seconds LOGOPT: DB '?' ; Primary option stored here DEFAULT$DISK: DB 0 ; Disk for open stored here DEFAULT$USER: DB 0 ; User for open stored here FCBCALLER: DB 0,'LASTCALR???' ; Last caller file FCB DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 ; CALLERPTR: DW LOGBUF ENDIF ; FCBLOG: IF LOGCAL DB 0,'KMD LOG' ; Log file FCB ENDIF ; IF LOGCAL 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 ; Rest of FCB LOGPTR: DW DBUF LOGCNT: DB 0 ENDIF ; IF LOGCAL OR ACCESS DSKSAV: DB 0 ; Up/download disk saved here USRSAV: DB 0 ; Up/download user saved here ENDIF ; IF LOGCAL LOGK: DB 'k ' ENDIF ; LOGCAL ; IF LOGCAL AND (RTC OR B3RTC OR BYEBDOS) YYSAV: DB 0 MMSAV: DB 0 DDSAV: DB 0 MNSAV: DB 0 ENDIF ; ; ============= ; ; 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 DB 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 ; FILE: DB 0,'FOR TXT' 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 ; IF B3RTC AND NOT BYEBDOS ; If BYE3/MBYE real-time clock RTCBUF: DW 0 ; Address of RTCBUF saved here ENDIF ; IF B3RTC AND NOT (MBMXT OR BYEBDOS) TOSSAV: DW 0 ENDIF ; IF 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) ; 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 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 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 MSGFLG: DB 0 ; Special flag for messge uploads 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 RWHEEL: DB 0 ; Shows wheel byte is set SPLFL: DB 0 ; Special flag for private downloads SYSABT: DB 0 ; Local sysop transfer abort with ^x 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 ; IF MSGDESC DMSG: DB 'Msg#: ????',CR,LF DFROM: DB 'From: ',CR,LF DTO: DB ' To: ALL',CR,LF DRE: DB ' Re: NEW UPLOAD: ' ENDIF ; IF NOT MSGDESC HLINE: DB '-----',CR,LF ENDIF ; 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 ; ; ======================== ; ; Extended BYEBDOS equates ; IF BYEBDOS BDMIST EQU 61 ; Modem raw input status BDMOST EQU 62 ; Modem raw output status BDMOUT EQU 63 ; Modem output 8 bit char BDMINP EQU 64 ; Modem input 8 bit char BDCSTA EQU 65 ; Modem carrier status BDCONS EQU 66 ; Local console input status BDCONI EQU 67 ; Local console input char BDCONO EQU 68 ; Local console output char BDMXDR EQU 69 ; Set/get maximum drive BDMXUS EQU 70 ; Set/get maximum user area BDNULL EQU 72 ; Set/get nulls BDTOUT EQU 71 ; Set/get idle timeout BDULCS EQU 73 ; Set/get upperlowercase switch BDLFMS EQU 74 ; Set/get line-feed mask BDHRDL EQU 76 ; Set/get hardlog BDWRTL EQU 75 ; Set/get writeloc BDMDMO EQU 77 ; Set/get mdmoff flag BDBELL EQU 78 ; Set/get bell mask flag BDGRTC EQU 79 ; Get address of rtc buffer BDGLCB EQU 80 ; Get address of lc buffer BDSTOS EQU 81 ; Maximum time on system BDSLGT EQU 82 ; Set login time BDPTOS EQU 83 ; Print Time on System ENDIF ; BYEBDOS ; ; ============= ; ; 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 256 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