CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / xmdm91kp.lbr / XMODEM91.AZM / XMODEM91.ASM

Wrap

Assembly Source File | 1993-10-25 | 75.0 KB | 3,232 lines

; 03/24/84 XMODEM91.ASM - REMOTE CP/M FILE TRANSFER PROGRAM ; ; Originally written by Keith Petersen W8SDZ, this program allows a re- ; mote user to transfer files (to or from) a RCPM facility. Files may ; be loaded to a specific user area, keeping all new programs in that ; one area. This aids the SYSOP as well as the remote user. If upload- ; ing a .COM file, an option changes it automatically to an .OBJ file. ; This security feature prevents intentional uploading of programs that ; could be used to alter (or erase, etc.) those already present. ; ; Many people have contributed greatly to the present program. ; ; SYSOPs may use MAXTIM to set the time limit for downloading files. It ; prevents users from tying up the system for excessive lengths of time ; with slow modems. For instance, 30 minutes limits 300 baud users to ; about 48k. MAXTIM does not kick them off, it stops them from starting ; to download a lengthy file. (A user could still download a number of ; files (each less than the limit) which would take several hours total, ; but it is an excellent start.) ; ; NOTE: Setting the SHOWHEX option to NO will give slightly faster file ; transfers - will save time converting and displaying the hex ; count, which is superfluous since the decimal count is already ; shown. ; - Notes by Irv Hoff W6FFC ; ; * * * * * * * * * * * * * * * * * * ; ; 03/24/84 Added a bit of code to allow counting the number of uploads ; or downloads since a user logged on. Set LOGLDS to YES to ; enable this. You must modify your BBS program to clear the ; locations UPLDS and DNLDS (54h and 55h) when a user logs in ; and check these locations when he logs out to determine how ; many up/down loads took place. I modified my BBS program to ; make this check on log in and update the last users file ; (the last user is still in LASTCALR.DAT), then clear locations ; UPLDS and DNLDS. This works fine. Its not the most elegant ; solution but a start. (The number of uploads on my RCPM ; increased dramaticly since people see a message like: ; "No of Downloads: 109, No of Uploads: 1" .... ; - Alex Soya, Melbourne RCPM- ; ; 02/26/84 Added code to check for zero length uploads and delete them. ; v9.0 The problem occurred with ZPRO, a non-public modem program ; that times out before xmodem and sent EOT causing xmodem to ; save zero-length filename. Changed console messages so that ; it says "Sent #" on downloads and "Received #" on uploads. ; -wayne masters- ; ; 02/22/84 Combined versions 8.7 and 8.8 so Sigi Kluger's mod is again ; v8.9 included. Note added that MAXMIN is limited to 99 minutes. ; Several modest changes requested by Wayne Masters for his ; time routine. - Irv Hoff ; ; 02/20/84 Added TIMEON equate and TIME routine to calculate the time a ; v8.8 user has been on and if STATUS is non-zero that delta time ; is added to the file transfer time. This sum is then com- ; pared to MAXMIN to see if user will exceed his total time ; limit. If he does, the transfer is aborted and the user is ; informed BEFORE the transfer is started. TIME is called at ; entry and exit and the message "Time on system is xx minutes" ; is printed. If xx is => MAXTIME the user is told not to ; call back for 24 hours automatically logged off. If STATUS ; is non-zero, the "Time on system" message is displayed but ; the delta is not added to the transfer time nor is he logged ; off after MAXMIN is exceeded. ; ; The SYSOP must add code to the beginning of TIME which will ; read his realtime clock and store BINARY values of the cur- ; rent hour (0-23) and the current minute (0-59) in locations ; pointed at by CHOUR and CMIN. The SYSOP must also code his ; BBS entry program (or BYE) to store the BINARY hour and min- ; utes of the user's logon time in LHOUR and LMIN. The BBS ; (or BYE) software should also determine if the user has ; special privledges (such as SYSOPs, frequent uploaders etc.) ; and store FF (or non-zero) in the byte pointed at by STATUS. ; Store a 0 in STATUS for normal users. ; ; If TIMEON and LOGCAL are both set YES, then SAVE 22 instead ; of 21 with DDT. If TIMEON is YES, MAXMIN should be set to ; 60. TIMEON uses 5 bytes in page one memory not used by CP/M ; (similiar to WHEEL and MAXDRIV). They are: ; ; CHOUR EQU 043H ;for basic ; CMIN EQU 044H ;programmers the decimal to poke ; LHOUR EQU 050H ;is 80 ; LMIN EQU 051H ;81 ; STATUS EQU 053H ;and 83 ; ; Be sure to store binary (not ASCII) in these locations. ; - Wayne Masters ; ; 02/05/84 If using RP or RPC with a filename shorter than the option ; v8.7 (RPC X for example), part of the option stayed in the file- ; name (above saved as "XPC"). Fixed now. ; - Sigi Kluger ; ; 01/20/84 Combined XMODM84A with XMODEM85. Time limit set by SYSOP ; v8.6 now displayed when a file exceeding the limit is requested. ; - Irv Hoff ; ; 01/04/84 Added buffer size equate. - Sigi Kluger ; v8.5 ; ; 01/04/84 Put back the MAXTIM routines to limit the transfer time of ; V8.4a files in minutes. This keeps a 300 bps caller from tying up ; your system with a 2 hour transfer of a LBR file. WHY DO ; PEOPLE KEEP TAKING THIS ROUTINE OUT... Also renamed LOGCAL ; file to XMODEM.LOG, it makes more sense and also cannot be ; typed due to the .LOG extent. ; - Steve Sanders ; ; 03/17/83 SYSOPS can now designate a special user area for downloading ; v7.2 private files. (See SPDRV, SPUSR below). This can make any ; user a temporary privileged person. Nobody but the SYSOP ; and the person to whom he left a private note would know the ; name of the file, so a high degree of security is possible. ; The menu also now shows the drive/area for uploading normal ; programs. This version standardizes receiving files. "R" ; or "PR" now receive via CRC and "RC" or "PRC" now receive ; via Checksum. This matches the "R" protocol used for some ; time with the COMM7, MODEM7 and MDM7 programs. When exiting ; the program, it always reverts to the initial drive and user ; area. Several other changes to fix bugs reported by various ; SYSOP's. - Irv Hoff ; ; ; * * * * * * * * * * * * * * * * * * ; ; XMODEM allows programs to be uploaded to a non-public area for private ; use of the SYSOP. (Use "RP" or "RPC" for the private area.) It also ; allows private programs to be downloaded from a special area, giving ; the SYSOP the ability to make any person a temporary privileged user. ; (A private note tells the person the name of the file. Others would ; be unaware such a file existed, insuring excellent security.) ; ; Individual files from a library group may be downloaded. The library ; extent (.LBR) need not be included, in which case it is automatically ; added. Using library groups permits greater utilization of the avail- ; able disk space, plus puts all associated files into the same program. ; An example is shown in the menu. ; ; Since there are so many different computer/modem combinations, you are ; expected to select one of the external overlays available to match the ; equipment being used (or make your own). First, select the general ; options desired on this program and assemble it. ASM.COM is suitable. ; Then use LOAD to get a .COM file. Edit the appropriate external over- ; lay and assemble it to get a .HEX file. DDT (or SID, etc.) would be ; used to merge the two into your final working .COM file. (The infor- ; mation on how to do this is contained in the external patch file. It ; is easier and quicker to do than it may appear. Follow instructions ; included in each overlay.) ; - Notes by Irv Hoff ; ; * * * * * * * * * * * * * * * * * * ; VERSION:EQU 9 MODLEV: EQU 1 ; NO: EQU 0 YES: EQU 0FFH ; ; ; Define ASCII characters used ; ACK: EQU 06H ;acknowledge BELL: EQU 7 ;bell CAN: EQU 18H ;CTL-X for cancel CR: EQU 0DH ;carriage return CRC: EQU 'C' ;CRC request character EOF: EQU 1AH ;^Z for end of file EOT: EQU 04H ;end of transmission LF: EQU 0AH ;linefeed NAK: EQU 15H ;negative acknowledge SOH: EQU 01H ;start of header ;..... ; ; ; Incidental equates ; MHZ: EQU 4 ;clock speed, use integer (2,4,5,8, etc.) NOCOMR: EQU YES ;yes, change .COM to .OBJ on receive NOCOMS: EQU YES ;yes, .COM files not sent NOLBS: EQU YES ;yes, .??# files not sent NOSYS: EQU YES ;yes, no $SYS files sent or reported ; ;======================================================================= ; ; Type of CP/M - standard starting at 100H or alterate starting address. ; STDCPM: EQU YES ;yes, if standard "zero ORG" CP/M, no if not ; ;======================================================================= ; ; Allows drive/user area to be specified for downloading. If using ZCPR ; set USEMAX 'YES'. Then the answers to MAXDRV and MAXUSR are superflu- ; ous. ; USEMAX: EQU YES ;yes if using ZCPR for DRIVMAX & USRMAX values ;no to use MAXDRV and MAXUSR specified next DRIVMAX:EQU 03DH ;location of MAXDRIV byte USRMAX: EQU 03FH ;location of MAXUSER byte ; ; ; If USEMAX above is YES for automatic ZCPR setting, the following two ; are not used. ; MAXDRV: EQU 2 ;number of disk drives used MAXUSR: EQU 7 ;maximum 'SEND' user allowed ; TIMEON: EQU YES ;If YES, add your clock reader code at the start ;of label TIME: and store binary values in CHOUR ; and CMIN ; IF TIMEON ;use these bytes in low memory CHOUR: EQU 043H ;some BIOS clocks keep time CMIN: EQU 044H ;here anyway. LHOUR: EQU 050H ;set by BBS (or BYE) in binary LMIN: EQU 051H ;when user logs on STATUS: EQU 053H ;and his status ENDIF ; LOGLDS EQU YES ;count no of Up/down loads since login. ;your BBS program can check UPLDS and DNLDS ;when user logs out and update either the users ;file or a file for this purpose. You can either ;modify your BBS entry program to check the Lastcalr ;file before updating it and then update (risky), ;or make a seperate program that BYE calls when ;logging off a user (prefered) ; IF LOGLDS UPLDS: EQU 054H ;Clear these values to Zero from your BBS program DNLDS: EQU 055H ;when somebody logs in. NOTE :Clear ONLY when a user ENDIF ;logs in. Not when he reenters the BBS program from ;CPM.... ; ;======================================================================= ; ; Some modems will either go onhook immediately after carrier loss or ; can be set to lower values. A good value with the Smartmodem is five ; seconds, since it catches all "call forwarding" breaks. Not all is ; lost after timeout in XMODEM; BYE will still wait some more, but the ; chance of someone slipping in is less now. ; TIMOUT: EQU 5 ;seconds to abort after carrier loss ; ;======================================================================= ; ; Length of external patch program. If over 128 bytes, get/set size ; LARGEIO:EQU NO ;yes, if modem patch area over 128 bytes LARSIZE:EQU 0 ;if 'LARGEIO' set patch area size here ; ;======================================================================= ; ; Type of modem being used - an external patch file needed in any event. ; ALTOS: EQU NO ;yes, if Altos computer EXTMOD: EQU YES ;yes, if external modem INTER3: EQU NO ;yes, if compupro Interfacer3/4 card ; ;======================================================================= ; ; Allows uploading to be done on a specified driver and user area so all ; viewers (indluding the SYSOP) can readily find the latest entries. ; SETAREA:EQU YES ;yes, if using designated area to receive files DRV: EQU 'B' ;drive to receive file on USR: EQU 0 ;user area to receive file in ; ;======================================================================= ; ; Selects the drive/user area for uploading private files for the SYSOP. ; This permits experimental files, replacement files and proprietary ; programs to be sent to the sysop. ; PRDRV: EQU 'B' ;private drive for SYSOP to receive file PRUSR: EQU 15 ;private user area for SYSOP to receive file ; ;======================================================================= ; ; Selects the drive/user area for downloading private files for SYSOP ; use. This permits him to put a special file in this area, then leave ; a private note to that person mentioning the name of the file and its ; location. Although anybody could download that program, they don't ; know what (if any) files are there. A high degree of security exists, ; while the sysop still has the ability to make special files available. ; Thus any person can be a temporary "privileged user". ; SPLDRV: EQU 'B' ;special drive area for downloading SYSOP files SPLUSR: EQU 15 ;special user area for downloading SYSOP files ; ;======================================================================= ; ; File transfer logging options ; LOGCAL: EQU YES ;yes, logs XMODEM transfers LOGUSR: EQU 14 ;user area to put 'XMODEM.LOG' file LOGDRV: EQU 'A' ;drive to place 'XMODEM.LOG' file LASTUSR:EQU 14 ;user area of 'LASTCALR' file, if 'LOGCAL' yes OLDRBBS:EQU NO ;yes, look for 'LASTCALR' file - no, look for ;'LASTCALR.DAT' file ; ;======================================================================= ; ; The receiving station sends an 'ACK' for each valid sector received. ; It sends a 'NAK' for each sector incorrectly received. In poor con- ; ditions either may be garbled. Waiting for a valid 'NAK' can slow ; things down somewhat, giving more time for the interference to quit. ; ACKNAK: EQU YES ;yes resends a record after any non-ACK ;no requires a valid NAK to resend a record ; ;======================================================================= ; ; Normal disk systems can transfer 16k from computer to disk in 2-3-4 ; seconds and less. Some very slow 5-1/4" floppy systems (such as North ; Star) may take up to 20-30 seconds to transfer 16k. This would cause ; several timeout at 10 seconds each. If you experience any such time ; out, change the BUFSIZ to somethng smaller, perhaps 4k or even 2k. ; (16k is the same buffer length used in MDM7 so both systems would be ; transferring from the buffer simultaneously, minimizing any delays.) ; BUFSIZ: EQU 16 ;file transfer buffer size in Kbytes ; ; ;======================================================================= ; ; Maximum transfer time allowed. I have found 30 minutes to be a good ; value. It limits callers at 300 bps to a 48K file and 1200 bps users ; can still transfer up to a 190K file. ; ; TIME 300 BPS 1200 BPS ; 30 min 48.7k 180k ; 45 min 73.1k 270k ; 60 min 97.5k 360k ; MAXTIM: EQU YES ;yes if limiting transmission time ; MAXMIN: EQU 60 ;minutes for maximum file transfer time ;this should be set to 60 if TIMEON is YES ;(99 minutes maximum.) ; ;======================================================================= ; ; Slightly faster file transfer times will occur if SHOWHEX is set NO as ; it does take time to caclulate, send and display the additonal count ; after each record in the file. The decimal count is already shown.. ; SHOWHEX:EQU NO ;yes, shows both decimal and hex record count ; ;no, shows only decimal record count ; ;(some users consider both to be superfluous, ; ;redundant, time-consuming and even confusing.) ; ;======================================================================= ; ; XMODEM is used with BYE to transfer files. It is nice to see the re- ; cord count displayed, but this creates a problem as those characters ; usually go out the modem as well. This would foul up the file tran- ; fer. The BYE program stores the original CONOUT vector which can be ; used for local display only. If the the following USECON equate is ; set YES, this address can be automatically located and placed in the ; XMODEM CONOUT location. ByeII programs support this feature. Also ; BYE3-17 and higher. If using some other program you have two options ; remaining, both apply to the external XMODEM overlay files. (Be sure ; to set USECON to NO in that case.) ; ; 1) Leave CONOUT in the overlay set to 00000H. ; This allows normal operation but without ; local visual update of the record count. ; 2) Manually find the address to set CONOUT in ; in the overlay. This procedure is listed ; in each overlay, if needed. ; USECON: EQU YES ;yes to get the original CONOUT address from ;ByeII or BYE3 (v1.7 and up). 'No' to get the ;CONOUT address the value set in the XMODEM ;overlay. ; ;======================================================================= ; IF STDCPM BASE: EQU 0000H ;CP/M base address ENDIF ; IF NOT STDCPM BASE: EQU 4200H ;alternate CP/M base address ENDIF ; ; ;----------------------------------------------------------------------- ; ; PROGRAM STARTS HERE ; ;----------------------------------------------------------------------- ; ; ORG BASE+100H ; JMP BEGIN ; ; ;----------------------------------------------------------------------- ; ; This is the I/O patch area. Assemble the appropriate I/O patch file ; for your modem, then integrate it into this program via DDT (or SID). ; ; Initially, all jumps are to zero, which will cause an unpatched ; XMODEM to simply execute a warm boot. All routines must end with RET. ; CONOUT: JMP 0 ;see 'CONOUT' discussion above MINIT: JMP 0 ;initialization routine (if needed) UNINIT: JMP 0 ;undo whatever MINIT did (or return) SENDR: JMP 0 ;send character (via POP PSW) CAROK: JMP 0 ;test for carrier MDIN: JMP 0 ;receive data byte GETCHR: JMP 0 ;get character from modem RCVRDY: JMP 0 ;check receive ready SNDRDY: JMP 0 ;check send ready (A-ERRCDE) SPEED: JMP 0 ;get speed value for transfer time EXTRA1: JMP 0 ;extra for custom routine EXTRA2: JMP 0 ;extra for custom routine EXTRA3: JMP 0 ;extra for custom routine ;..... ; ; ;----------------------------------------------------------------------- ; IF NOT LARGEIO ;I/O patch area size up to 128 bytes ORG BASE+100H+80H ;origin plus 128 bytes for patches ENDIF IF LARGEIO ;I/O patch area size if over 128 bytes ORG BASE+100H+LARSIZE ENDIF ;..... ; ; ; Save CP/M stack, initialize new one for this program ; BEGIN: LXI H,0 DAD SP SHLD STACK LXI SP,STACK ;initialize new stack ; ; ; Save the current drive and user area ; MVI E,0FFH ;get the current user area MVI C,USER CALL BDOS STA OLDUSR ;save user number here MVI C,CURDRV ;get the current drive CALL BDOS STA OLDDRV ;save drive here ; IF TIMEON CALL TIME ;get user's time status ENDIF ;TIMEON ; CALL ILPRT ;print: DB CR,LF,'XMODEM v',VERSION+'0','.',MODLEV+'0',' ',0 ; ; ; Stuff address of BIOS CONOUT vector in our routine as default. ; IF USECON LHLD 1 ;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 ; ; ; Go through a big search to see if BYE is active. If so, need to re- ; calculate the address of the original BIOS vector. ; LHLD 1 ;point to warm boot again DCX H ;if BYE active, MOV D,M ; pick up pointer to BYE variables DCX H MOV E,M LXI H,15 ;calculate address of BYE variable DAD D ; where ptr to orig BIOS vector stored MOV E,M ;load that address INX H ; into DE. If BIOS active, DE now pnts MOV D,M ; to original BIOS cold boot 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 CPI 'B' ;try to match 'BYE' (or 'Bye') JNZ NOBYE ;out if BYE not active INX H MOV A,M ANI 05FH ;convert to upper case if needed CPI 'Y' JNZ NOBYE INX H MOV A,M ANI 05FH ;convert to upper case if needed CPI 'E' JNZ NOBYE XCHG ;point to the console output routine SHLD CONOUT+1 ;save vector address supplied by BYE ; NOBYE: ENDIF ;USECON ; ; ; Get option ; LXI H,FCB+2 ;first off, check for 'P' (private) MOV A,M CPI 'P' ;if not, then normal stuff... JNZ CHKOPT DCX H ;first character in buffer MOV A,M CPI 'R' JNZ OPTNERR ;if not, is an error STA PRVTFL ;otherwise set 'PRIVATE' flag INX H INX H MOV A,M CPI 'C' ;checksum checking requested? JZ CHKOPT1 ;if yes, go set flag JMP CHKOPT2 ; CHKOPT: CPI 'C' ;checksum checking requested? JNZ CHKOPT2 ;no, go check primary LDA FCB+1 ;get primary option CPI 'R' ;checksum only for receive JNZ OPTNERR ;print error message then abort ; CHKOPT1:STA CRCFLG ;turn on the checksum flag ; CHKOPT2:LDA FCB+1 ;get option (L, R or S) STA OPTSAV ;save option for later use PUSH PSW CPI 'R' JNZ CHKOPT4 LDA CRCFLG ORA A JZ CHKOPT3 CALL ILPRT DB 'Checksum enabled',0 JMP CHKOPT4 ; CHKOPT3:CALL ILPRT DB '(CRC is enabled)',0 ; CHKOPT4:CALL ILPRT DB CR,LF,0 ; ; ; Gobble up garbage characters from the line prior to receive or send ; and initialize whatever has to be initialized ; CALL GETCHR CALL GETCHR CALL MINIT ; ; ; Jump to appropriate function ; POP PSW ;get option ; IF LOGCAL PUSH PSW ;but save it ENDIF ;LOGCAL ; CPI 'L' ;to send a file from a library? JZ SENDFIL CPI 'R' ;to receive a file? JZ RCVFIL CPI 'S' JZ SENDFIL ;otherwise go send a file ; ; ; Invalid option ; OPTNERR:CALL ILPRT DB CR,LF,'++ Examples of valid options: ++',0 ; IF NOT SETAREA CALL ILPRT DB CR,LF,0 ENDIF ;NOT SETAREA ; IF SETAREA CALL ILPRT DB ' (Uploads files to ',DRV,0 LXI H,USR CALL DECOUT CALL ILPRT DB ':)',CR,LF,0 ENDIF ;SETAREA ; CALL ERXIT ;exit with error DB ' XMODEM L PRINT.LBR PRINT.INF to send a file ' DB 'from a library',CR,LF DB ' XMODEM L CATALOG CAT2.OBJ (.LBR extent may ' DB 'be omitted)',CR,LF DB ' XMODEM S FILENAME.TYP to send a file' DB CR,LF DB ' XMODEM S B6:HELLO.DOC to send from a ' DB 'named drive/area',CR,LF DB ' XMODEM R (or RC) FILENAME.TYP to receive a file' DB CR,LF DB ' XMODEM RP (or RPC) FILENAME.TYP to receive in a ' DB 'private area',CR,LF,CR,LF DB ' (The "C" in RC or RPC receives via checksum rather ' DB 'than CRC)' DB '$' ;..... ; ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; ---> SENDFIL sends a CP/M file ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; The CP/M file specified in the XMODEM command is transferred over the ; phone to another computer running modem with the "R" (receive) option. ; The data is sent one record at a time with headers and checksums, and ; retransmission on errors. ; SENDFIL:CALL LOGDU ;check file name or drive/user option LDA OPTSAV CPI 'L' ;if library option skip 'CNREC' CNZ CNREC ;ignore if in library mode CALL OPENFIL ;open the file MVI E,100 ;wait 100 sec for initial 'NAK' CALL WAITNAK ; SENDLP: CALL RDRECD ;read a record JC SENDEOF ;send 'EOF' if done CALL INCRRNO ;bump record number XRA A ;initialize error count to zero STA ERRCT ; SENDRPT:CALL SENDHDR ;send a header CALL SENDREC ;send data record LDA CRCFLG ;get 'CRC' flag ORA A ;'CRC' in effect? CZ SENDCRC ;yes, send 'CRC' CNZ SENDCKS ;no, send checksum CALL GETACK ;get the 'ACK' JC SENDRPT ;repeat if no 'ACK' LDA OPTSAV ;get the command option again CPI 'L' JNZ SNRPT1 ;if not library option, exit LHLD RCNT MOV A,H ORA L ;see if L and H both zero now JZ SENDEOF ;if finished, exit DCX H ;if not both zero, more remaining SHLD RCNT ;one less to go ; SNRPT1: JMP SENDLP ;loop until EOF ;..... ; ; ; File sent, send EOT's ; SENDEOF:MVI A,EOT ;send an 'EOT' CALL SEND CALL GETACK ;get the ACK JC SENDEOF ;loop if no ACK ; IF LOGLDS LDA DNLDS ;get Down loads Counter INR A ;one more download since log in STA DNLDS ;and update counter ENDIF ;LOGLDS ; JMP EXITLG ;all done ;..... ; ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; ---> RCVFIL Receive a CP/M file ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; Receives a file in block format as sent by another person doing ; "XMODEM S FM.FT". Can be invoked by "XMODEM R FN.FT" or by ; "XMODEM RC FN.FT" if Checksum is to be used. ; RCVFIL: CALL LOGDU ;check file name or drive/user option ; IF SETAREA MVI A,DRV-40H STA FCB ENDIF ;SETAREA ; LDA PRVTFL ;receiving to a private area? ORA A JZ RCVFIL1 ;if not, exit MVI A,PRDRV-40H ;private area takes precedence STA FCB ;store drive to be used ; RCVFIL1: IF NOCOMR LXI H,FCB+9 ;point to filetype MVI A,'C' ;1st letter CMP M ;is it C ? JNZ CONTINU ;if not, continue normally INX H ;get 2nd letter MVI A,'O' ;2nd letter CMP M ;is it O ? JNZ CONTINU ;if not, continue normally INX H ;get 3rd letter MVI A,'M' ;3rd letter CMP M ;is it M ? JNZ CONTINU ;if not, continue normally CALL ILPRT ;print renaming message DB 'Auto-renaming file to ".OBJ"',CR,LF,0 LXI H,FCB+9 MVI M,'O' INX H MVI M,'B' INX H MVI M,'J' ENDIF ;NOCMR ; CONTINU:CALL ILPRT ;print the message DB 'File will be received on ',0 LDA PRVTFL ;going to store in the private area? ORA A LDA XPRDRV ;get private drive JNZ CONTIN1 ;if yes, it takes priority LDA OLDDRV ;otherwise get current drive ADI 'A' ;convert to ASCII ; IF SETAREA LDA XDRV ;setarea uses a specified drive ENDIF ;SETAREA ; IF NOT SETAREA NOTDRV: DB 0,0 ;filled in by 'GETDU' if requested ENDIF ;NOT SETAREA ; CONTIN1:CALL CTYPE ;print the drive to store on LDA PRVTFL ;going to store in the private area? ORA A LDA XPRUSR ;get private user area JNZ CONTIN2 ;if yes, it takes priority LDA OLDUSR ;get current drive ; IF SETAREA LDA XUSR ;setarea takes next precedence ENDIF ;SETAREA ; IF NOT SETAREA NOTUSR: DB 0,0 ;filled in by 'GETDU' if requested ENDIF ;NOT SETAREA ; CONTIN2:MVI H,0 MOV L,A CALL DECOUT ;print the user area CALL ILPRT DB ':',CR,LF,0 CALL CHEKFIL ;see if file exists CALL MAKEFIL ;if not, start a new file CALL ILPRT DB 'File open - ready to receive',CR,LF,0 ; RCVLP: CALL RCVRECD ;get a record JC RCVEOT ;got 'EOT' CALL WRRECD ;write the record CALL INCRRNO ;bump record number CALL SENDACK ;ack the record JMP RCVLP ;loop until 'EOF' ;..... ; ; ; Got EOT on record so flush buffers then done ; RCVEOT: LDA RECDNO ;check for zero length record CPI 0 JNZ EOT1 ;at least some upload LDA RECDNO+1 ;check second byte CPI 0 JNZ EOT1 CALL RCVSABT ;abort and erase the zero length file JMP EXIT ;and exit EOT1 CALL WRBLOCK ;write the last block CALL SENDACK ;ack the record CALL CLOSFIL ;close the file ; IF LOGLDS LDA UPLDS ;get Upload Counter INR A ;one more upload since log in STA UPLDS ;update Counter ENDIF ;LOGLDS ; JMP EXITLG ;all done ;..... ; ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; SUBROUTINES ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ; ; ---> LOGDU Log into drive and user (if specified). If none mentioned ; it falls through to 'TRAP' routine for normal use. ; LOGDU: LXI H,DEFDMA ;point to default buffer command line MOV B,M ;store number of chars. in command INR B ;add in current location ; LOG1: CALL CHKSP ;skip spaces to find 1st command JZ LOG1 ; LOG2: CALL CHKSP ;skip 1st command (non-spaces) JNZ LOG2 INX H CALL CHKFSP ;skip spaces to find 2nd command SHLD SAVEHL ;save start address of the 2nd command ; ; ; Now point to the first byte in the argument, i.e., if it was of format ; similar to: B6:HELLO.DOC then we point at the drive character 'B'. ; LXI D,DUSAVE MVI C,4 ;drive/user is 4 chars. 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 ; ; ; ---> TRAP Check for no file name or ambiguous name ; TRAP: CALL MOVEFCB ;move the filename into the file block LXI H,FCB+1 ;point to file name MOV A,M ;get first char of file name CPI ' ' ;any there? JNZ ATRAP ;yes, check for ambigous file name ; NFN: CALL ERXIT ;print message, exit DB '++ No file name requested ++$' ;... ; ; ATRAP: MVI B,11 ;11 characters to check ; TRLOOP: MOV A,M ;get char from FCB CPI '?' ;ambiguous? JZ TRERR ;yes, exit with error message CPI '*' ;even more ambiguous? JZ TRERR ;yes, exit with error message INX H ;point to next character DCR B ;one less to go JNZ TRLOOP ;not done, check some more RET ;...... ; ; TRERR: CALL ERXIT ;print message, exit DB '++ Wild-card options are not valid ++$' ;..... ; ; ; ---> GETDU Get <D>isk and <U>ser from DUSAVE and log in if valid. ; GETDU: CALL CHKFSP ;see if a file name is included SHLD SAVEHL ;save location of the filename LDA PRVTFL ;uploading to a private area? ORA A JNZ TRAP ;if yes, going to a specified area LXI H,DUSAVE ;point to drive/user MVI A,YES ;reset to provide for current drive STA DUD MOV A,M ;get 1st character CPI 'A'-1 JC NUMERIC ;satisfied with current drive SUI 'A' ; IF NOT USEMAX CPI MAXDRV JNC ILLDU ;drive selection not available ENDIF ;NOT USEMAX ; IF USEMAX PUSH H LXI H,DRIVMAX ;point to max drive byte INR M CMP M ;and check it PUSH PSW ;save flags from the CMP DCR M ;restore max drive to normal POP PSW ;restore flags from the CPM JNC ILLDU POP H ENDIF ;USEMAX ; STA DUD ;save drive INX H ;get 2nd character ; NUMERIC:MOV A,M CPI ':' JZ OK4 ;colon for drive only, no user number CALL CKNUM ;check if numeric SUI '0' ;convert ascii to binary STA DUU ;save it INX H ;get 3rd character if any MOV A,M CPI ':' JZ OK1 LDA DUU CPI 1 ;is first number a '1'? JNZ ILLDU MOV A,M CALL CKNUM SUI '0'-10 STA DUU INX H ;get 4th (and last character) if any MOV A,M CPI ':' JNZ ILLDU ; OK1: LDA OPTSAV ;get the option back CPI 'R' ;receiving a file? LDA DUU ;get desired user area JZ OK2 ;yes, can not use special download area LDA DUD ;get desired drive CPI SPLDRV-'A' ;special download drive requested? LDA DUU ;get user area requested JNZ OK2 ;if none, exit CPI SPLUSR ;special download area requested? JZ OK3 ;if yes, process request ; OK2: IF NOT USEMAX CPI MAXUSR+1 ;check for maximum user download area JNC ILLDU ;error if more (and not special area) ENDIF ;NOT USEMAX ; IF USEMAX PUSH H LXI H,USRMAX ;point at max user byte CMP M ;and check it JNC ILLDU POP H ENDIF ;USEMAX ; OK3: MOV E,A ; IF NOT SETAREA STA NOTUSR+1 ;store requested user area MVI A,3EH ;'MVI A,--' instruction STA NOTUSR ENDIF ;NOT SETAREA ; MVI C,USER CALL BDOS ;set to requested user area ; OK4: LDA DUD ;get drive MOV E,A ; IF NOT SETAREA ADI 'A' STA NOTDRV+1 ;store requested drive MVI A,3EH ;'MVI A,--' instruction STA NOTDRV ENDIF ;NOT SETAREA ; MVI C,SELDRV CALL BDOS ;set to requested drive ; XIT: JMP TRAP ;now find file selected ;..... ; ; CKNUM: CPI '0' JC ILLDU ;error if less than ascii '0' CPI '9'+1 RC ;error if more than ascii '9' ;... ; ; ILLDU: CALL ERXIT DB '++ Improper drive/user combination ++$' ;..... ; ; ; Check next character to see if a space or non-space, file name error ; if no ASCII character. ; CHKFSP: DCR B JZ NFN ;error if end of chars. MOV A,M CPI ' '+1 RNC ;ok if valid character so return INX H JMP CHKFSP ;look at next character ;..... ; ; ; Check next character to see if a space or non-space, go to menu if a ; command error. ; CHKSP: DCR B JZ OPTNERR INX H MOV A,M ;get the char. there CPI ' ' ;space character? RET ;JZ = space, JNZ = non-space ;..... ; ; ; ---> RCVRECD Receive a record ; ; Returns with carry bit set if EOT received ; RCVRECD:XRA A ;initialize error count to zero STA ERRCT ; RCVRPT: XRA A ;get 0 STA ERRCDE ;clear receive error code MVI B,10-1 ;10-second timeout CALL RECV ;get any character received JC RCVSTOT ;timeout CPI SOH ;hoping for a 'SOH' JZ RCVSOH ;yes ORA A JZ RCVRPT ;ignore nulls CPI CRC ;ignore our own 'CRC' if needed JZ RCVRPT CPI NAK ;ignore our own 'NAK' if needed JZ RCVRPT CPI EOT ;end of transfer? STC ;return with carry set if 'EOT' RZ ; ; ; Didn't get SOH or EOT - or - didn't get valid header - purge the line, ; then send nak ; RCVSERR:MVI B,1 ;wait for 1 second CALL RECV ;after last char. received JNC RCVSERR ;loop until sender done LDA CRCFLG ;get 'CRC' flag ORA A ;'CRC' in effect? MVI A,NAK ;put 'NAK' in accum JNZ RCVSER2 ;no, send the 'NAK' LDA FRSTIM ;get first time switch ORA A ;has first 'SOH' been received? MVI A,NAK JNZ RCVSER2 ;yes, then send 'NAK' MVI A,CRC ;tell sender 'CRC' is in effect ; RCVSER2:CALL SEND ; the 'NAK' or 'CRC' request LDA ERRCT ;abort if INR A ; we have reached STA ERRCT ;the error CPI 10 ; limit? JC RCVRPT ; no, try again ; ; ; Error limit exceeded, so abort ; RCVSABT:CALL CLOSFIL ;keep whatever we got CALL ILPRT DB CR,LF,CR,LF,'++ RECEIVED FILE CANCELLED ++',0 CALL DELFILE ;delete received file CALL ERXIT ;print second half of message DB '++ UNFINISHED FILE DELETED ++$' ; ; ; ---> DELFILE deletes the received file (used if receive aborts) ; DELFILE:LXI D,FCB ;point to file MVI C,ERASEF ;get function CALL BDOS ;delete it INR A ;delete ok? RNZ ; yes, return CALL ERXIT ; no, abort DB '++ Can''t delete received file ++$' ; ; ; Timed out on receive ; RCVSTOT:JMP RCVSERR ;bump error count, etc. ; ; ; Got SOH - get block number, block number complemented ; RCVSOH: MVI B,1 ;timeout = 1 sec STA FRSTIM ;indicate first 'SOH' received CALL RECV ;get record JC RCVSTOT ;got timeout MOV D,A ;D=block number MVI B,1 ;timeout = 1 sec CALL RECV ;get complimented record number JC RCVSTOT ;timeout CMA ;calculate the complement CMP D ;good record number? JZ RCVDATA ;yes, get data ; ; ; Got bad record number ; JMP RCVSERR ;bump error count ;... ; ; RCVDATA:MOV A,D ;get record number STA RCVRNO ;save it MVI C,0 ;initialize checksum CALL CLRCRC ;clear CRC counter MVI D,128 ;initialize the count LHLD RECPTR ;get buffer address ; RCVCHR: MVI B,1 ;1 sec timeout CALL RECV ;get the character JC RCVSTOT ;timeout MOV M,A ;store the character INX H ;point to next character DCR D ;done? JNZ RCVCHR ;no, loop if <= 128 LDA CRCFLG ;get 'CRC' flag ORA A ;'CRC' in effect? JZ RCVCRC ;yes, to receive 'CRC' ; ; ; Verify checksum ; MOV D,C ;save checksum MVI B,1 ;timeout length CALL RECV ;get checksum JC RCVSTOT ;timeout CMP D ;checksum ok? JNZ RCVSERR ;no, error ; ; ; Got a record, it's a duplicate if = previous, or OK if = 1 + previous ; record ; CHKSNUM:LDA RCVRNO ;get received MOV B,A ;save it LDA RECDNO ;get previous CMP B ;prev repeated? JZ RECVACK ;'ACK' to catch up INR A ;calculate next record number CMP B ;match? JNZ ABORT ;no match - stop sender, exit RET ;carry off - no errors ; ; ---> RCVCRC Receive the Cyclic Redundancy Check characters (2 bytes) ; and see if the CRC received matches the one calculated. ; If they match, get next record, else send a NAK request- ; ing the record be sent again. ; RCVCRC: MVI E,2 ;number of bytes to receive ; RCVCRC2:MVI B,1 ;1 sececond timeout CALL RECV ;get crc byte JC RCVSTOT ;timeout DCR E ;decrement the number of bytes JNZ RCVCRC2 ;get both bytes CALL CHKCRC ;check received CRC against calc'd CRC ORA A ;is CRC okay? JZ CHKSNUM ;yes, go check record numbers JMP RCVSERR ;go check error limit and send NAK ; ; ; Previous record repeated, due to the last ACK being garbaged. ACK it ; so sender will catch up ; RECVACK:CALL SENDACK ;send the ACK JMP RCVRECD ;get next block ;..... ; ; ; Send an ACK for the record ; SENDACK:MVI A,ACK ;get 'ACK' CALL SEND ; and send it RET ;..... ; ; ; ---> SENDHDR Send the record header ; ; Send (SOH) (block number) (complemented block number) ; SENDHDR:MVI A,SOH ;send CALL SEND ; 'SOH', LDA RECDNO ;then send CALL SEND ; record number LDA RECDNO ;then record number CMA ; complemented CALL SEND ; record number RET ;from SENDHDR ;..... ; ; ; ---> SENDREC send the data record ; SENDREC:MVI C,0 ;initialize checksum CALL CLRCRC ;clear the 'CRC' counter MVI D,128 ;initialize the count LHLD RECPTR ;get buffer address ; SENDC: MOV A,M ;get a character CALL SEND ;send it INX H ;point to next character DCR D ;done? JNZ SENDC ;loop if <=128 RET ;from SENDREC ;..... ; ; ; ---> SENDCKS send the checksum ; SENDCKS:MOV A,C ;send the CALL SEND ; checksum RET ;from 'SENDCKS' ;..... ; ; ; ---> SENDCRC Send the two Cyclic Redundancy Check characters. Call ; FINCRC to calculate the CRC which will be in 'DE' upon ; return. ; SENDCRC:CALL FINCRC ;calculate the 'CRC' for this record MOV A,D ;put first 'CRC' byte in accumulator CALL SEND ;send it MOV A,E ;put second 'CRC' byte in accumulator CALL SEND ;send it XRA A ;set zero return code RET ;..... ; ; ; ---> GETACK Get the ACK on the record ; ; Returns with carry clear if ACK received. If an ACK is not received, ; the error count is incremented, and if less than 10, carry is set and ; the record is resent. if the error count is 10, the program aborts. ; waits 12 seconds to avoid any collision with the receiving station. ; GETACK: MVI B,12 ;wait 12 seconds max CALL RECVDG ;receive with garbage collect JC ACKERR ;timed out CPI ACK ;was it an 'ACK' character? RZ ;yes, return ; IF NOT ACKNAK CPI NAK ;was it an authentic 'NAK'? JNZ GETACK ;ignore if neither 'ACK' nor 'NAK' ENDIF ;NOT ACKNAK ; ; ; Timeout or error on ACK - bump error count then resend the record if ; error limit is not exceeded ; ACKERR: LDA ERRCT ;get count INR A ;bump it STA ERRCT ;save back CPI 10 ;at limit? RC ;if not, go resend the record ; ; ; Reached error limit ; CSABORT:CALL ERXIT DB '++ SEND FILE CANCELLED ++$' ;..... ; ; ABORT: LXI SP,STACK ; ABORTL: MVI B,1 ;one second without characters CALL RECV JNC ABORTL ;loop until sender done MVI A,CAN ;CTL-X CALL SEND ;stop sending end ; ABORTW: MVI B,1 ;one second without chracters CALL RECV JNC ABORTW ;loop until sender done MVI A,CR ;get a space... CALL SEND ;to clear out CTL-X CALL ERXIT ;exit with abort message DB '++ XMODEM ABORTED ++$' ;..... ; ; ; ---> INCRRNO increment record number ; INCRRNO:PUSH H LHLD RECDNO ;increment record number INX H SHLD RECDNO ; IF NOT USECON ;save the check if guaranteed conout LHLD CONOUT+1 ;check to see if showing count on crt MOV A,H ;if both zero, user did not fill out ORA L ; 'CONOUT: jmp 0000H' in patch area JZ INCRN5 ; with his own console output address ENDIF ;NOT USECON ; ; ; Display the record count on the local CRT if "CONOUT" was filled in by ; the implementor MVI A,1 STA CONONL ;set local only LDA OPTSAV ;see if receive or send mode CPI 'R' JZ RMSG CALL ILPRT DB CR,'Sent # ',0 JMP REST RMSG: CALL ILPRT DB CR,'Received # ',0 REST: LHLD RECDNO CALL DECOUT CALL ILPRT DB ' ',0 ; IF SHOWHEX ;if yes, shows both decimal and hex CALL ILPRT DB '(',0 CALL DHXOUT CALL ILPRT DB 'H) ',0 ENDIF ;SHOWHEX ; XRA A ;reset the flag for local only STA CONONL ; INCRN5: POP H ;here from above if no CONOUT RET ;..... ; ; ; ---> CHEKFIL See if file exists ; ; If it exists, say use a different name. ; CHEKFIL: IF NOT SETAREA LDA PRVTFL ;receiving in private area? ORA A CNZ RECAREA ;if yes, set drive and user area ENDIF ;NOT SETAREA ; IF SETAREA CALL RECAREA ;set the designated area up ENDIF ;SETAREA ; CHEKFIL1: LXI D,FCB ;point to control block MVI C,SRCHF ;see if it CALL BDOS ; exists INR A ;found? RZ ; no, return CALL ERXIT ;exit, print error message DB '++ File exists, use a different name ++$' ; ; ; ---> MAKEFIL Makes the file to be received ; MAKEFIL:XRA A ;set extent and record number to 0 STA FCBEXT STA FCBRNO LXI D,FCB ;point to FCB MVI C,MAKE ;get bdos FNC CALL BDOS ;to the make INR A ;0FFH=bad? RNZ ;open ok ; ; ; Directory full - can't make file ; CALL ERXIT DB '++ Error: can''t make file -' DB ' directory may be full? ++$' ; ; ; ---> CNREC Computes record count, and saves it until a successful ; file-open. ; ; Look up the FCB in the directory ; CNREC: MVI C,CFSIZE ;computes file size LXI D,FCB CALL BDOS ;read first LHLD RANDOM ;get the file size SHLD RCNT ;save total record count MOV A,H ORA L RNZ ;return if not zero length ; NONAME: CALL ERXIT DB '++ No file with that name ++$' ;..... ; ; ; ---> OPENFIL Opens the file to be sent ; OPENFIL:XRA A ;set extent and rec number to 0 STA FCBEXT ; for proper open STA FCBRNO LXI D,FCB ;point to file MVI C,OPEN ;get function CALL BDOS ;open it INR A ;open ok? JNZ OPENOK ;if yes, exit LDA OPTSAV ;get command line option CPI 'L' ;want to send a library file? JNZ NONAME ;exit, if not CALL ILPRT DB CR,LF,'++ No library file with that name ++',CR,LF,0 JMP OPTNERR ;..... ; ; ; Check for distribution-protected file ; OPENOK: LDA FCB+1 ;first char of file name ANI 80H ;check bit 7 JNZ OPENOT ;if on, file can not be sent LDA FCB+2 ;also check 'F2' for tab ANI 80H ;is is set? ; IF NOSYS JNZ OPENOT LDA FCB+10 ANI 80H JNZ NONAME ;if $SYS then fake a "file not found" ENDIF ;NOSYS ; JZ OPENOK2 ;if not, ok to send file ; OPENOT: CALL ERXIT ;exit with message DB '++ File is not for distribution, sorry ++$' ;... ; ; OPENOK2:LDA OPTSAV CPI 'L' JNZ OPN2 LXI D,DEFDMA MVI C,SETDMA CALL BDOS MVI C,READ LXI D,FCB CALL BDOS LHLD 8EH SHLD DIRSZ LXI H,DEFDMA MOV A,M ORA A JZ CKDIR ;check directory present? ; NOTLBR: CALL ERXIT DB '++ Library directory invalid? ++$' ;..... ; ; ; --> CKDIR Check to see if there is a .LBR file directory with that ; name and complain if not. ; CKDIR: MVI B,11 ;maximum length of file name MVI A,' ' ;first entry must be all blanks INX H ; CKDLP: CMP M JNZ NOTLBR DCR B INX H JNZ CKDLP ; ; ; The first entry in the .LBR directory is indeed blank. Now see if the ; directory size is more than 0. MOV D,M ;get directory starting location INX H ;...which must be 0000H... MOV A,M ORA D JNZ NOTLBR ;directory does not start in record 0 INX H MOV A,M ;get size of directory INX H ORA M JZ NOTLBR ;directory must be >0 records! LXI H,DEFDMA ;point to directory ; ; ; The next routine checks the .LBR directory for the specified member. ; Name one sector at a time. ; CMLP: MOV A,M ;get member active flag ORA A ;00=active, anything else can be... MVI B,11 ;...regarded as invalid (erased or blank) INX H ;point to member name JNZ NOMTCH ;no match if inactive entry ; CKLP: LDAX D ;now compare the file name specified... CMP M ;...against the member file name JNZ NOMTCH ;exit loop if no match found INX H INX D DCR B JNZ CKLP ;check all 11 characters MOV E,M ;got the file - get file address INX H MOV D,M XCHG SHLD INDEX ;save file address in .LBR XCHG INX H MOV E,M ;get the file size INX H MOV D,M XCHG DCX H SHLD RCNT ;save size a # of records LHLD INDEX ;get file address SHLD RANDOM ;place it into random field XRA A STA RANDOM+2 ;must zero the 3rd byte STA FCBRNO ;also zero FCB record # LXI D,FCB ;point to FCB of .LBR file MVI C,RRDM ;read random CALL BDOS JMP OPENOK3 ;no need to error check ;... ; ; ; Come here if no file name match and another sector is needed ; NOMTCH: INX H ;skip past the end of the file entry DCR B JNZ NOMTCH LXI B,20 ;point to next file entry DAD B LXI D,MEMFCB ;point to member name again MOV A,H ;see if we checked all 4 entries ORA A JZ CMLP ;no, check next LHLD DIRSZ ;get directory size MOV A,H ORA L JNZ INLBR ;continue if still more to check CALL ERXIT DB '++ Library does not have that file ++$' ; INLBR: DCX H ;decrement dirctory size SHLD DIRSZ MVI C,READ ;read next sector of directory LXI D,FCB CALL BDOS LXI H,DEFDMA ;set our pointers for compare LXI D,MEMFCB JMP CMLP ;check next sector ;..... ; ; OPN2: IF NOLBS OR NOCOMS ;check for send restrictions LXI H,FCB+11 MOV A,M ;check for protect attr ANI 7FH ;remove CP/M 2.x attrs ENDIF ;NOLBS OR NOCOMS ; IF NOLBS ;do not allow '#' to be sent CPI '#' ;chk for '#' as last first JZ OPENOT ;if '#', can not send, show why ENDIF ;NOLBS ; IF NOCOMS ;do not allow '.COM' to be sent CPI 'M' ;if not, check for '.COM' JNZ OPENOK3 ;if not, ok to send DCX H MOV A,M ;check next character ANI 7FH ;strip attributes CPI 'O' ;'O'? JNZ OPENOK3 ;if not, ok to send DCX H MOV A,M ;now check 1st character ANI 7FH ;strip attributes CPI 'C' ;'C' as in '.COM'? JNZ OPENOK3 ;if not, continue CALL ERXIT ;exit with message DB '++ Can''t Send a .COM File ++$' ENDIF ;NOCOMS ;..... ; ; OPENOK3:CALL ILPRT ;print the message DB 'File open: ',0 LHLD RCNT ;get record count LDA OPTSAV CPI 'L' JNZ OPENOK4 ;if send from library add 1 to INX H ;show correct record count ; OPENOK4:CALL DECOUT ;print decimal number of records CALL ILPRT ; IF SHOWHEX ;if yes, shows both decimal and hex DB ' (',0 CALL DHXOUT CALL ILPRT DB 'H)' ENDIF ;SHOWHEX ; DB ' records',CR,LF DB 'Send time: ',0 CALL SPEED ;get speed indicator LXI D,0 MOV E,A ;set up for table access LXI H,BTABLE ;point to baud factor table DAD D ;index to proper factor MOV A,M ;factor in 'A' LHLD RCNT ;get number of records CALL DIVHLA ;divide HL by value in a (records/min) PUSH H ; IF LOGCAL SHLD PGSIZE ENDIF ;LOGCAL ; MVI H,0 ; IF MAXTIM MOV A,L ;If limiting send time, PUSH H LXI H,TON ADD M ;add time on to xfer time, TON will al- POP H ; ways be 0 if TIMEON is NO STA MINUTE ;store value for later comparison ENDIF ;MAXTIM ; CALL DECOUT ;print decimal number of minutes CALL ILPRT DB ' mins, ',0 LXI H,RECTBL ;point to divisors for seconds calc. LXI D,0 CALL SPEED ;get speed indicator MOV E,A DAD D ;index into table MOV A,M ;get multiplier POP H ;get remainder CALL MULHA ;multiply 'H' by 'A' CALL SHFTHL CALL SHFTHL CALL SHFTHL CALL SHFTHL MVI H,0 CALL DECOUT ;print the seconds portion CALL ILPRT DB ' secs at ',0 LXI H,SPTBL ;start of baud rate speeds MVI D,0 ;zero the 'D' register CALL SPEED ;get speed indicator ADD A ;index into the baud rate table ADD A MOV E,A ;now have the index factor in 'DE' DAD D ;add to 'HL' XCHG ;put address in 'DE' regs. MVI C,PRINT ;show the baud CALL BDOS CALL ILPRT DB ' bps',CR,LF,0 ; IF MAXTIM LDA MINUTE ;get minute count CPI MAXMIN+1 ;compare to MAXTIM value JNC OVERTM ;if greater than MAXTIM ENDIF ;MAXTIM ; CALL ILPRT DB 'To cancel: use CTRL-X',CR,LF,0 RET ;... ; ; IF MAXTIM OVERTM: CALL ILPRT DB CR,LF,'++ XMODEM ABORTED - send time exceeds the ',0 LXI H,MAXMIN CALL DECOUT CALL ERXIT1 DB ' minutes allowed ++',BELL,'$' ENDIF ;MAXTIM ;..... ; ; BTABLE: DB 5,13,20,24,30,48,0 RECTBL: DB 192,74,48,40,32,20,0 SPTBL: DB '110$','300$','450$','600$','710$','1200$' ;... ; ; ; ---> DIVHLA Divides 'HL' by value in 'A' ; upon exit: L=quotient, H=remainder ; DIVHLA: PUSH B MVI B,8 ;shift factor to 'B' MOV C,A ;divisor to 'C' ; DIV2: XRA A ;clear carry flag and accumulator DAD H MOV A,H SUB C JM DIV3 ;do not borrow on negative results MOV H,A MOV A,L ORI 1 ;borrow 1 MOV L,A ; DIV3: DCR B JNZ DIV2 POP B RET ;... ; ; ; ---> MULHA Multiply the value in 'H' by the value in 'A' ; Return with answer in 'HL'. ; MULHA: MOV B,A ;put loop count in 'B' MVI D,0 MOV E,H MOV L,H MVI H,0 ; MULLP: DCR B RZ DAD D JMP MULLP RET ; ; ; Shift the 'HL' pair one bit to the right ; SHFTHL: MOV A,L RAR MOV L,A ORA A ;clear the carry bit MOV A,H RAR MOV H,A RNC MVI A,80H ORA L MOV L,A RET ;..... ; ; ; ---> CLOSFIL Closes the received file ; CLOSFIL:LXI D,FCB ;point to file MVI C,CLOSE ;get function CALL BDOS ;close it INR A ;close ok? RNZ ; yes, return CALL ERXIT ; no, abort DB '++ Can''t close file ++$' ;..... ; ; ; ---> DECOUT Decimal output routine - call with decimal value in 'HL' ; DECOUT: PUSH B PUSH D PUSH H LXI B,-10 LXI D,-1 ; DECOU2: DAD B INX D JC DECOU2 LXI B,10 DAD B XCHG MOV A,H ORA L CNZ DECOUT MOV A,E ADI '0' CALL CTYPE POP H POP D POP B RET ;..... ; ; ; ---> DHXOUT Double precision hex output routine. Call with hex ; value in 'HL'. ; DHXOUT: PUSH H ;save HL PUSH PSW ;save a MOV A,H ;get MSBs byte CALL HEXO ;output high order byte MOV A,L ;get LSB byte CALL HEXO ;output low order byte POP PSW ;restore 'A' reg. POP H ;restore 'HL' RET ;return to caller ; ; ; ---> RDRECD Reads a record ; ; For speed, this routine buffers up 16 records at a time. ; RDRECD: LDA RECNBF ;get number of records in buffer DCR A ;decrement it STA RECNBF JM RDBLOCK ;exhausted? need more LHLD RECPTR ;get buffer address LXI D,128 ;add length of one record DAD D ; to next buffer SHLD RECPTR ;save buffer address RET ;from 'READRED' ;..... ; ; ; Buffer is empty - read in another block of 16 ; RDBLOCK:LDA EOFLG ;get 'EOF' flag CPI 1 ;is it set? STC ;to show 'EOF' RZ ;got 'EOF' MVI C,0 ;records in block LXI D,DBUF ;to disk buffer ; RDRECLP:PUSH B PUSH D MVI C,SETDMA ;set DMA address CALL BDOS LXI D,FCB MVI C,READ CALL BDOS POP D POP B ORA A ;read ok? JZ RDRECOK ;yes DCR A ;'EOF'? JZ REOF ;got 'EOF' ; ; ; Read error ; CALL ERXIT DB '++ File read error ++$' ;... ; ; RDRECOK:LXI H,128 ;add length of one record DAD D ; to next buffer XCHG ;buffer to 'DE' INR C ;more records? MOV A,C ;get count CPI BUFSIZ*8 ;done? JZ RDBFULL ; yes, buffer is full JMP RDRECLP ;read more ;... ; ; REOF: MVI A,1 STA EOFLG ;set EOF flag MOV A,C ; ; ; Buffer is full, or got eof ; RDBFULL:STA RECNBF ;store record count LXI H,DBUF-128 ;init buffer pointear SHLD RECPTR ;save buffer address LXI D,DEFDMA ;reset DMA address MVI C,SETDMA CALL BDOS JMP RDRECD ;pass record to caller ;..... ; ; ; ---> WRRECD Write a record ; ; Writes the record into a buffer. When 16 have been written, writes ; the block to disk. ; ; Entry point "WRBLOCK" flushes the buffer at EOF ; WRRECD: LHLD RECPTR ;get buffer address LXI D,128 ;add length of one record DAD D ; to next buffer SHLD RECPTR ;save buffer address LDA RECNBF ;bump the INR A ; record number STA RECNBF ; in the buffer CPI BUFSIZ*8 ;have we 16? RNZ ;no, return ; ; ; ---> WRBLOCK Writes a block to disk ; WRBLOCK:LDA RECNBF ;number of records in the buffer ORA A ;0 means end of file RZ ;none to write MOV C,A ;save count LXI D,DBUF ;point to disk buff ; DKWRLP: PUSH H PUSH D PUSH B MVI C,SETDMA ;set DMA CALL BDOS ;to buffer LXI D,FCB ;then write the block MVI C,WRITE CALL BDOS POP B POP D POP H ORA A JNZ WRERR ;oops, error LXI H,128 ;length of 1 record DAD D ;'HL'= next buff XCHG ;to 'DE' for setdma DCR C ;more records? JNZ DKWRLP ; yes, loop XRA A ;get a zero STA RECNBF ;reset number of records LXI H,DBUF ;reset buffer buffer SHLD RECPTR ;save buffer address ; RSDMA: LXI D,DEFDMA ;reset DMA address MVI C,SETDMA CALL BDOS RET ;..... ; ; WRERR: CALL RSDMA ;reset DMA to normal MVI C,CAN ;cancel CALL SEND ; sender CALL RCVSABT ;kill receive file CALL ERXIT ;exit with msg: DB '++ Error writing file ++$' ;..... ; ; ;----> RECV Receive a character ; ; Timeout time is in 'B' in seconds. Entry via 'RECVDG' deletes garbage ; characters on the line. For example, having just sent a record, ; calling 'RECVDG' will delete any line-noise-induced characters "long" ; before the ACK/NAK would be received. ; RECVDG: CALL GETCHR CALL GETCHR ; RECV: PUSH D ;save 'DE' regs. MVI E,MHZ ;get the clock speed XRA A ;clear the 'A' reg. ; MSLOOP: ADD B ;number of seconds DCR E ;one less mhz. to go JNZ MSLOOP ;if not zero, continue MOV B,A ;put total value back into 'B' ; MSEC: LXI D,6600 ;1 second DCR count ; MWTI: CALL RCVRDY ;input from modem ready ; JZ MCHAR ;got the character DCR E ;count down for timeout JNZ MWTI DCR D JNZ MWTI DCR B ;more seconds? JNZ MSEC ;yes, wait ; ; ; Test for the presence of carrier - if none, go to 'CARCK' and continue ; testing for specified time. If carrier returns, continue. If it does ; not return, exit. ; CALL CAROK ;is carrier still on? CNZ CARCK ;if not, test for 15 seconds ; ; ; Modem timed out receiving - but carrier is still on. ; POP D ;restore 'DE' STC ;carry shows timeout RET ;..... ; ; ; Get character from modem. ; MCHAR: CALL MDIN ;get data byte from modem POP D ;restore 'DE' ; ; ; Calculate Checksum and CRC ; PUSH PSW ;save the character CALL UPDCRC ;calculate CRC ADD C ;add to checksum MOV C,A ;save checksum POP PSW ;restore the character ORA A ;carry off: no error RET ;from 'RECV' ;..... ; ; ; CARCK - common carrier test for receive and send. If carrier returns ; within TIMOUT seconds, normal program execution continues. Else, it ; will abort to CP/M via EXIT. ; CARCK: MVI E,TIMOUT*10 ;value for 15 second delay ; CARCK1: CALL DELAY ;kill .1 seconds CALL CAROK ;is carrier still on? RZ ;return if carrier on DCR E ;has 15 seconds expired? JNZ CARCK1 ;if not, continue testing ; ; ; See if got a local console, and report if so. ; IF NOT USECON ;do not test if guaranteed conout LHLD CONOUT+1 ;get conout address MOV A,H ;zero if no local console ORA L JZ CARCK2 ENDIF ;NOT USECON ; MVI A,1 ;print local only STA CONONL CALL ILPRT ;report loss of carrier DB CR,LF,'++ Carrier lost in XMODEM ++',CR,LF,0 ; CARCK2: LDA OPTSAV ;get option CPI 'R' ;if not receive JNZ EXIT ;then abort now, else CALL DELFILE ;get rid of the junk first JMP EXIT ;else, abort to CP/M ; ; ; Delay - 100 millisecond delay. ; DELAY: PUSH B ;save 'BC' LXI B,MHZ*4167 ;value for 100 ms. delay ; DELAY2: DCX B ;update count MOV A,B ;get MSP byte ORA C ;count = zero? JNZ DELAY2 ;if not, continue POP B ;restore 'BC' RET ;return to CARCK1 ;..... ; ; ; ---> SEND Send a character to the modem ; SEND: PUSH PSW ;save the character CALL UPDCRC ;calculate CRC ADD C ;calcculate checksum MOV C,A ;save cksum ; SENDW: CALL SNDRDY ;is transmit ready JZ SENDR ; yes, go send ; ; ; Xmit status not ready, so test for carrier before looping - if lost, ; go to CARCK and give it up to 15 seconds to return. If it doesn't, ; return abort via EXIT. ; PUSH D ;save 'DE' CALL CAROK ;is carrier still on? CNZ CARCK ;if not, continue testing it POP D ;restore 'DE' JMP SENDW ;else, wait for xmit ready ; ; ; ---> WAITNAK Waits for initial NAK ; ; To ensure no data is sent until the receiving program is ready, this ; routine waits for the first timeout-nak or the letter 'C' for CRC ; from the receiver. If CRC is in effect, then Cyclic Redundancy Checks ; are used instead of checksums. 'E' contains the number of seconds to ; wait. ; ; If the first character received is a CAN (CTL-X) then the send will be ; aborted as though it had timed out. ; WAITNAK:MVI B,1 ;timeout delay CALL RECV ;did we get CPI CRC ;'CRC' indicated? RZ ;yes, send block CPI NAK ;a 'NAK' indicating checksum? JZ SETNAK ;yes go put checksum in effect CPI CAN ;was it a cancel (CTL-X)? JZ ABORT ;yes, abort DCR E ;finished yet? JZ ABORT ;yes, abort JMP WAITNAK ;no, loop ;..... ; ; ; ---> WAITCRC Turn on CRC flag ; SETNAK: MVI A,'C' ;make sure in checksum STA CRCFLG RET ;..... ; ; ; ---> MOVEFCB Moves the filename to the FCB ; ; This routine moves the filename from the default command line buffer ; to the file control block (FCB). ; MOVEFCB:LHLD SAVEHL ;get position on command line CALL GETB ;get numeric position LXI D,FCB+1 CALL MOVENAM ;move name to FCB XRA A STA FCBRNO ;zero record number STA FCBEXT ;zero extent LDA OPTSAV ;this going to be a library file? CPI 'L' RNZ ;if not, finished ; ; ; Handles library entries, first checks for proper .LBR extent. If no ; extent was included, it adds one itself. ; SHLD SAVEHL LXI H,FCB+9 ;1st extent 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 DEFDMA+2 ;start location of 1st command MOV B,A ;store for now LDA DEFDMA ;find length of command line SUB B ;subtract those already used MOV B,A ;now have number of bytes remaining RET ;..... ; ; LBRERR: CALL ERXIT DB '++ Invalid library name ++$' ;..... ; ; MEMERR: CALL ILPRT DB CR,LF,'++ No library member file requested ++',CR,LF,0 JMP OPTNERR ;..... ; ; ; Add .LBR extent to the library file name ; NOEXT: LXI H,FCB+9 ;location of extent MVI M,'L' INX H MVI M,'B' INX H MVI M,'R' JMP MOVEF1 ;now get the library member name ;..... ; ; ; Move a file name from the 'DEFDMA' command line buffer into FCB ; MOVENAM:MVI C,1 ; MOVEN1: MOV A,M CPI ' '+1 ;name ends with space or return 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 OPTNERR ;end of name, see if done yet JMP MOVEN1 ;..... ; ; ; See if any spaces needed between file name and .ext ; CHKFIL: CALL FILLSP ;fill with spaces JMP MOVEN2 ;..... ; ; FILLSP: MOV A,C CPI 9 RNC ;up to 1st character in .ext now MVI A,' ' ;be sure there is a blank there now STAX D INR C INX D JMP FILLSP ;go do another ;..... ; ; CTYPE: PUSH B ;save all registers PUSH D PUSH H MOV E,A ;character to 'E' in case BDOS (normal) LDA CONONL ;want to bypass 'BYE' output to modem? ORA A JNZ CTYPEL ;yes, go directly to CRT, then MVI C,WRCON ;BDOS console output, to CRT and modem CALL BDOS ; since 'BYE' intercepts the char. POP H ;restore all registers POP D POP B RET ;... ; ; CTYPEL: MOV C,E ;BIOS needs it in 'C' CALL CONOUT ;BIOS console output routine, not BDOS POP H ;restore all registers saved by 'CTYPE' POP D POP B RET ;..... ; ; HEXO: PUSH PSW ;save for right digit RAR ;right justify the left digit RAR RAR RAR CALL NIBBL ;print left digit POP PSW ;restore right ; NIBBL: ANI 0FH ;isolate digit ADI 90H DAA ACI 40H DAA JMP CTYPE ;type it ;..... ; ; ; ---> ILPRT Inline print of message ; ; The call to ILPRT is followed by a message, binary 0 for its end. ; ILPRT: XTHL ;save HL, get HL=message ; ILPLP: MOV A,M ;get the character ORA A ;end of message? JZ ILPRET ; yes, return CALL CTYPE ;type the message INX H ;to next character JMP ILPLP ;loop ;... ; ; ILPRET: XTHL ;restore HL RET ;past message ;..... ; ; EXITLG: IF LOGCAL ;special log caller exit JMP LOGCALL ENDIF ;LOGCAL ; JMP EXIT ;..... ; ; ; ---> ERXIT Exit printing message following call ; ERXIT: CALL ILPRT DB CR,LF,0 ; ERXIT1: POP D ;get message MVI C,PRINT ;get BDOS FNC CALL BDOS ;print message CALL ILPRT DB CR,LF,0 ; EXIT: IF TIMEON CALL TIME ;tell user how long he's been on ENDIF ;TIMEON ; CALL UNINIT ;reset vectors (if needed) LDA OLDDRV ;restore the original drive MOV E,A CALL RECDRX LDA OLDUSR ;restore the original number MOV E,A CALL RECARE XRA A LHLD STACK SPHL RET ;..... ; ; ; ---> Restore the old user area and drive from a received file ; ; ---> Set user area to receive file ; RECAREA:CALL RECDRV ;ok set the drive to its place LDA PRVTFL ;private area wanted? ORA A MVI E,PRUSR ;yes, set to private area JNZ RECARE MVI E,USR ;ok now set the user area ; RECARE: MVI C,USER ;tell BDOS what we want to do CALL BDOS ;now do it RET ;..... ; ; RECDRV: LDA PRVTFL ORA A MVI E,PRDRV-'A' ;make drive CP/M number JNZ RECDRX MVI E,DRV-'A' ;make drive CP/M number ; RECDRX: MVI C,SELDRV ;tell BDOS CALL BDOS ;do it RET ;back ;..... ; ; ; Move 128 characters from 'HL' to 'DE' length in 'B' ; MOVE128: MVI B,128 ;set move count ; MOVE: MOV A,M ;get a character STAX D ;store it INX H ;to next 'from' INX D ;to next 'to' DCR B ;more? JNZ MOVE ; yes, loop RET ; no, return ;..... ; ; ;*********************************************************************** ; ; CRC SUBROUTINES ; ;*********************************************************************** ; ; CHKCRC: PUSH H ;check 'CRC' bytes of received message LHLD CRCVAL MOV A,H ORA L POP H RZ MVI A,0FFH RET ;..... ; ; CLRCRC: PUSH H ;reset 'CRC' store for a new message LXI H,0 SHLD CRCVAL POP H RET ;..... ; ; FINCRC: PUSH PSW ;finish 'CRC' calculation for final 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 routine ; IF LOGCAL BSIZE: EQU 80H SECT: EQU 80H ; ; ; The following allocations are used by the 'FILE' macros ; DEFAULT$USER: DB LASTUSR CUR$USER: DB 0FFH DEFAULT$DISK: DB LOGDRV-'A' CUR$DISK: DB 0FFH PGSIZE: DB 0,0 ; LOGCALL: JMP M010 ; FCBCALLER: DB 0,'LASTCALR' ENDIF ;LOGCAL ; IF LOGCAL AND OLDRBBS DB ' ',0 ENDIF ;LOCAL AND OLDRBBS ; IF LOGCAL AND (NOT OLDRBBS) DB 'DAT',0 ENDIF ;LOGCAL AND (NOT OLDRBBS) ; IF LOGCAL DS 23 DB 0FFH ; CALLERADR: DW DBUF CALLERSIZ: EQU BSIZE CALLERLEN: DW BSIZE CALLERPTR: DS 2 M010: JMP M001 ; GETCALLER: LHLD CALLERLEN XCHG LHLD CALLERPTR MOV A,L SUB E MOV A,H SBB D JC M007 LXI H,0 SHLD CALLERPTR ; M004: XCHG LHLD CALLERLEN MOV A,E SUB L MOV A,D SBB H JNC M006 LHLD CALLERADR DAD D XCHG MVI C,SETDMA CALL BDOS LDA FCBCALLER+36 CPI 0FFH JZ M009 MVI C,USER MOV E,A CALL BDOS ; M009: LXI D,FCBCALLER MVI C,RRDM CALL BDOS CALL RESET$SYSTEM ORA A JNZ M005 LHLD FCBCALLER+33 INX H SHLD FCBCALLER+33 LXI D,SECT LHLD CALLERPTR DAD D SHLD CALLERPTR JMP M004 ; M005: LHLD CALLERPTR SHLD CALLERLEN ; M006: LXI D,DEFDMA MVI C,SETDMA CALL BDOS LXI H,0 SHLD CALLERPTR ; M007: XCHG LHLD CALLERADR DAD D XCHG LHLD CALLERLEN MOV A,L ORA H MVI A,EOF RZ LDAX D LHLD CALLERPTR INX H SHLD CALLERPTR RET ;..... ; ; OPENF: PUSH D MVI A,0FFH ;declare current user area on file STA FILEUA MVI C,VERNO ;get version number CALL BDOS MOV A,H ;cp/m 1.x? ORA L JZ START2$DISK ;check for default disk if so MVI E,0FFH ;get current user number MVI C,USER ;get user code CALL BDOS MOV C,A LDA DEFAULT$USER ;check if at default user CMP C JZ START2$DISK ;do not try if at default user area STA FILEUA ;where the file is if anywhere MOV E,A MOV A,C STA CUR$USER ;where we are (save for later) MVI C,USER ;set user code to default user CALL BDOS ; START2$DISK: MVI C,CURDRV ;see if current disk is default drive CALL BDOS MOV C,A LDA DEFAULT$DISK ;check if at default disk CMP C POP H ;FCB into HL PUSH H ;preserve stack JZ START3$DISK INR A ;add one to disk number MOV M,A ;put into FCB ; START3$DISK: XCHG ;FCB into DE MVI C,OPEN ;open file CALL BDOS CPI 255 ;not present? ; M012: POP D ;get the FCB again (and clean up stack) PUSH PSW ;save open status on file LXI H,36 DAD D LDA FILEUA ;get the user area for the file MOV M,A ;put user area into FCB POP PSW RET ;..... ; ; M001: XRA A STA FCBCALLER+12 STA FCBCALLER+32 LXI H,CALLERSIZ SHLD CALLERLEN SHLD CALLERPTR LXI D,FCBCALLER JMP M011 ;..... ; ; RESET$SYSTEM: PUSH PSW LDA CUR$USER ;check user CPI 0FFH ;0FFH=no change JZ RESET$RET MOV E,A ;user in 'E' reg. MVI C,USER ;get/set user code CALL BDOS ; RESET$RET: POP PSW RET ;..... ; ; FILEUA: DS 1 ; M011: CALL OPENF JNZ M003 CALL ERXIT DB '++ NO LASTCALR ++$' ENDIF ;LOGCAL ; IF LOGCAL AND (NOT OLDRBBS) DB '.DAT' ENDIF ;LOGCAL AND (NOT OLDRBBS) ; IF LOGCAL DB ' FILE FOUND ++' ; M003: MVI C,SETRRD ;get random record # LXI D,FCBCALLER CALL BDOS CALL RESET$SYSTEM MVI A,LOGUSR STA DEFAULT$USER JMP M022 ;... ; ; FCBLOG: DB 0,'XMODEM LOG',0 DS 23 DB 0FFH ; LOGADR: DW LOGBUF LOGSIZ: EQU BSIZE LOGLEN: DW BSIZE LOGPTR: DS 2 ; M022: JMP M013 ;... ; ; GETLOG: LHLD LOGLEN XCHG LHLD LOGPTR MOV A,L SUB E MOV A,H SBB D JC M019 LXI H,0 SHLD LOGPTR ; M016: XCHG LHLD LOGLEN MOV A,E SUB L MOV A,D SBB H JNC M018 LHLD LOGADR DAD D XCHG MVI C,SETDMA CALL BDOS LDA FCBLOG+36 CPI 0FFH JZ M021 MVI C,USER MOV E,A CALL BDOS ; M021: LXI D,FCBLOG MVI C,RRDM CALL BDOS CALL RESET$SYSTEM ORA A JNZ M017 LHLD FCBLOG+33 INX H SHLD FCBLOG+33 LXI D,SECT LHLD LOGPTR DAD D SHLD LOGPTR JMP M016 ; M017: LHLD LOGPTR SHLD LOGLEN ; M018: LXI D,DEFDMA MVI C,SETDMA CALL BDOS LXI H,0 SHLD LOGPTR ; M019: XCHG LHLD LOGADR DAD D XCHG LHLD LOGLEN MOV A,L ORA H MVI A,EOF RZ LDAX D LHLD LOGPTR INX H SHLD LOGPTR RET ;..... ; ; M013: XRA A STA FCBLOG+12 STA FCBLOG+32 LXI H,LOGSIZ SHLD LOGLEN SHLD LOGPTR LXI D,FCBLOG CALL OPENF JNZ M015 MVI A,EOF STA LOGBUF LXI H,0 SHLD LOGPTR LXI D,FCBLOG MVI C,MAKE CALL BDOS INR A JNZ M015 CALL ERXIT DB '++ NO DIR SPACE: LOG ++$' ;... ; ; BACKLOG:LXI H,LOGSIZ SHLD LOGLEN LHLD LOGPTR MOV A,L ORA H RZ DCX H SHLD LOGPTR ; LLOG: LHLD FCBLOG+33 MOV A,L ORA H RZ DCX H SHLD FCBLOG+33 RET ;..... ; ; M015: JMP M023 ; PUTLOG: PUSH PSW LHLD LOGLEN XCHG LHLD LOGPTR MOV A,L SUB E MOV A,H SBB D JC M029 LXI H,0 SHLD LOGPTR ; M026: XCHG LHLD LOGLEN MOV A,E SUB L MOV A,D SBB H JNC M028 LHLD LOGADR DAD D XCHG MVI C,SETDMA CALL BDOS LDA FCBLOG+36 CPI 0FFH JZ M031 MVI C,USER MOV E,A CALL BDOS ; M031: LXI D,FCBLOG MVI C,WRDM CALL BDOS CALL RESET$SYSTEM ORA A JNZ M027 LHLD FCBLOG+33 INX H SHLD FCBLOG+33 LXI D,SECT LHLD LOGPTR DAD D SHLD LOGPTR JMP M026 ; M027: CALL ERXIT DB '++ DISK FULL - CANNOT ADD TO LOG ++$' ; M028: LXI D,DEFDMA MVI C,SETDMA CALL BDOS LXI H,0 SHLD LOGPTR ; M029: XCHG LHLD LOGADR DAD D XCHG POP PSW STAX D LHLD LOGPTR INX H SHLD LOGPTR RET ;..... ; ; M023: MVI C,CFSIZE ;get file length LXI D,FCBLOG CALL BDOS CALL LLOG ; M030: CALL GETLOG CPI EOF JNZ M030 CALL BACKLOG CALL RESET$SYSTEM POP PSW ;get option back CALL PUTLOG CALL SPEED ;get speed factor ADI 30H CALL PUTLOG LDA PGSIZE ;now the program size in minuntes.. CALL PNDEC ;..of transfer time MVI A,' ' ;blank CALL PUTLOG ; ; ; Log the drive and user area as a prompt ; LDA FCB ORA A JNZ WDRV MVI C,CURDRV CALL BDOS INR A ; WDRV: ADI 'A'-1 CALL PUTLOG MVI C,USER ;now the user area (as decimal number) MVI E,0FFH CALL BDOS CALL PNDEC MVI A,'>' ;make it look like a prompt CALL PUTLOG LDA OPTSAV CPI 'L' JNZ WDRV1 LXI H,MEMFCB ;name of file in library MVI B,11 CALL PUTSTR MVI A,' ' CALL PUTLOG ; WDRV1: LXI H,FCB+1 ;now the name of the file MVI B,11 CALL PUTSTR LDA OPTSAV CPI 'L' JNZ WDRV2 MVI C,1 JMP SPLOOP ; WDRV2: MVI C,13 ; SPLOOP: PUSH B MVI A,' ' CALL PUTLOG POP B DCR C JNZ SPLOOP ; CLOOP: CALL GETCALLER ;and the caller CPI EOF JZ QUIT CPI CR ;do not print 2nd line of 'LASTCALR' JNZ CLOP1 CALL PUTLOG MVI A,LF CALL PUTLOG ;and add a LF JMP QUIT ;... ; ; CLOP1: CPI ',' ;do not print the ',' between names JNZ CLOP2 MVI A,' ' ;instead send a ' ' ; CLOP2: CALL PUTLOG JMP CLOOP ;..... ; ; PNDEC: CPI 10 ;two column decimal format routine JC ONE ;one or two digits to area number? JMP TWO ;... ; ; ONE: PUSH PSW MVI A,'0' CALL PUTLOG POP PSW ; TWO: MVI H,0 MOV L,A ; DECOT: PUSH B PUSH D PUSH H LXI B,-10 LXI D,-1 ; DECOT2: DAD B INX D JC DECOT2 LXI B,10 DAD B XCHG MOV A,H ORA L CNZ DECOT MOV A,E ADI '0' CALL PUTLOG POP H POP D POP B RET ;..... ; ; PUTSTR: MOV A,M PUSH H PUSH B CALL PUTLOG POP B POP H INX H DCR B JNZ PUTSTR RET ;..... ; ; QUIT: M033: LHLD LOGPTR MOV A,L ANI (SECT-1) AND 0FFH JNZ M034 SHLD LOGLEN ; M034: MVI A,EOF PUSH PSW CALL PUTLOG POP PSW JNZ M033 LDA FCBLOG+36 CPI 0FFH JZ M037 MVI C,USER MOV E,A CALL BDOS ; M037: LXI D,FCBLOG MVI C,CLOSE CALL BDOS CALL RESET$SYSTEM INR A JNZ EXIT CALL ERXIT DB '++ CANNOT CLOSE LOG ++$' ; ;..... ENDIF ;LOGCAL ; ; end of LOGCAL routine ;*********************************************************************** ; ; TIME CALCULATE USERS ELAPSED TIME ; ;*********************************************************************** ; ; Calculate time on system and inform user. Log him off if =>MAXMIN ; unless STATUS is non-zero. ; IF TIMEON TIME: NOP ;the sysop must add the code here neces- NOP ; sary to read his clock and store NOP ; binary values of current hours (0-23) NOP ; in CHOUR and minutes (0-59) in CMIN LXI H,LHOUR ;point to log-on hour LDA CHOUR ;current hour CMP M ;equal? JNZ TIME1 ;no LDA LMIN ;log on minutes MOV D,A LDA CMIN ;current minutes SUB D STA TON ;store total time on JMP TIME2 ; TIME1: LDA LMIN ;log on min MOV D,A MVI A,03CH ;60 min into A SUB D LXI H,CMIN ;point at current min ADD M ;add current minutes STA TON ; TIME2: LDA STATUS ;look at user status ORA A ;special user? JNZ TIME3 ;yes, skip log off check XRA A ;clear status bits LDA TON SUI MAXMIN ;subtract max time allowed JC TIME3 ;still time left CALL TIMEUP ;time is up, inform user MVI A,0CDH ;alter jump vector STA 0 ;at zero JMP 0 ;and log him off ; TIME3: LXI H,MSG1+015H ;point at message insert bytes LDA TON ;convert to ASCII MVI B,-1 ; 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 LDA STATUS ;check user status ORA A ;special user? JNZ TIME5 ;yes, reset TON 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 ENDIF ; TON: DB 0 ;TON will always be 0 if TIMEON is NO ; ; ;*********************************************************************** ; ; Temporary storage area ; ;*********************************************************************** ; MINUTE: DB 0 ;transfer time in mins for MAXTIM MEMFCB: DB ' ' ;library name (16 bytes required) CONONL: DB 0 ;CTYPE console-only flag CRCFLG: DB 0 ;sets to 'C' if checksum requested CRCVAL: DB 0,0 ;current CRC value DIRSZ: DB 0,0 ;directory size DUD: DB 0 ;specified disk DUSAVE: DB 0,0,0,0 ;buffer for drive/user DUU: DB 0 ;specified user ERRCDE: DB 0 ;receive error code ERRCT: DB 0 ;error count FRSTIM: DB 0 ;turned on after first 'SOH' received INDEX: DB 0,0 ;index into directory MAXEXT: DB 0 ;highest ext. # seen in file size calc. RCNT: DB 0,0 ;record count RCVRNO: DB 0 ;record number received RECDNO: DB 0,0 ;current record number OLDDRV: DB 0 ;save the original drive number OLDUSR: DB 0 ;save the original user number OPTSAV: DB 0 ;save option here for carrier loss PRVTFL: DB 0 ;private user area option flag SAVEHL: DB 0,0 ;saves DEFDMA command line address XDRV: DB DRV XPRDRV: DB PRDRV XUSR: DB USR XPRUSR: DB PRUSR ; ; ; Following 3 used by disk buffering routines ; EOFLG: DB 0 ;'EOF' flag (1=yes) RECPTR: DW DBUF RECNBF: DW 0 ;number of records in the buffer ; DS 60 ;stack area STACK: DS 2 ;save original stack address ; ; ; 16-record disk buffer ; DBUF: DS 0 ;16-record disk buffer LOGBUF: EQU DBUF+128 ;for use with LOGCAL ; ; ;*********************************************************************** ; ; BDOS equates ; ;*********************************************************************** ; WRCON: EQU 2 PRINT: EQU 9 VERNO: EQU 12 ;get CP/M version number SELDRV: EQU 14 ;select drive OPEN: EQU 15 ;0FFH = not found CLOSE: EQU 16 ; " " SRCHF: EQU 17 ; " " SRCHN: EQU 18 ; " " ERASEF: EQU 19 ;no return code READ: EQU 20 ;0=OK, 1=EOF WRITE: EQU 21 ;0=OK, 1=ERR, 2=?, 0FFH=no directory spc MAKE: EQU 22 ;0FFH=bad CURDRV: EQU 25 ;get current drive SETDMA: EQU 26 ;set DMA USER: EQU 32 ;set user area to receive file RRDM: EQU 33 ;read random WRDM: EQU 34 ;write random CFSIZE: EQU 35 ;compute file size SETRRD: EQU 36 ;set random record BDOS: EQU BASE+05H DEFDMA: EQU BASE+80H ;default DMA address FCB: EQU BASE+5CH ;system FCB FCB1: EQU BASE+6CH ;second FCB FCBEXT: EQU FCB+12 ;file extent FCBRNO: EQU FCB+32 ;record number RANDOM: EQU FCB+33 ;random record field ;..... ; ; END