home *** CD-ROM | disk | FTP | other *** search
-
- VERSION EQU 700 ;MODM700 as of 11/04/84 -- CP/M MODEM PROGRAM
- ;
- ; This modem program uses the Christensen protocol. It has both 'CRC'
- ; and CHECKSUM capability for error detection. It supports dialing
- ; and auto-redialing for the Anchor Automation Signalman Mark XII,
- ; US Robotics modems, the Hayes Smartmodem 300 and 1200 and PMMI
- ; S-100 modems. It supports up to two alternate dialing systems
- ; such as 'MCI', 'SPRINT', etc.
- ;
- ; Other external modems may be used, although manual dialing may be
- ; necessary. Many overlays are available to allow easy configuration
- ; on various computers using I/O devices including the 2661, 8250, 8251,
- ; Z80-SIO, and many others.
- ;
- ; NOTE: Current version is 73 sectors long. Use this figure when using
- ; DDT, etc. to merge the appropriate overlay, regardless of what
- ; the overlay may call for (such as 66 sectors for overlays made
- ; when the program was not as lengthy.)
- ;
- ;***********************************************************************
- ;
- ; THIS PROGRAM IS IN THE PUBLIC DOMAIN.
- ;
- ;***********************************************************************
- ;
- ; When transferring files modem-to-modem, the batch mode is extremely
- ; useful. It allows automatic transmission of multiple files. It can
- ; be used for single files or with wildcards. With normal single program
- ; transfer, the receiving end switches from CRC to checksum in one minute
- ; and times out completely in 120 seconds. (In batch mode it times out
- ; in 3 minutes for receive.) This allows ample opportunity to transfer
- ; programs between individuals.
- ;
- ; M7NM-6.ASM can be used to change the telephone overlay numbers
- ; and/or set the alternate dialing system code (also used to
- ; change HEXSHO and SAVSIZ, mentioned below.)
- ;
- ; M7LIB.COM can be used to easily change any of the telephone
- ; overlay numbers.
- ;
- ; M7FNK.COM can be used to easily change any of the 10 function
- ; key assignments (or the function key intercept character
- ; itself, which is currently the '^' character.
- ;
- ; Significant address changes now used:
- ;
- ; 0DFEH - HEXSHO 00 = do not show hex record count
- ; FF = show both hex and decimal count
- ; 0DFFH - SAVSIZ 20 = 4k file transfer buffer size
- ; 40 = 8k file transfer buffer size
- ; 80 = 16k file transfer buffer size
- ; 0E00H - NUMLIB (start of telephone number library)
- ;
- ;***********************************************************************
- ;
- ; Many people have contributed ideas for this modem program:
- ;
- ; Ward Christensen, Jim Mills, Mark Zeigler, Keith Petersen,
- ; Paul Kelly, Bruce Ratoff, John Mahr, Rich Berg, Bob Clyne,
- ; Bill Earnest, Paul Hansknecht, Ron Fowler, Fred Viles, Bob
- ; Plouffe, Ben Bronson, Sigi Kluger, Irv Hoff, Frank Gaude'
- ; and others.
- ;
- ;***********************************************************************
- ;
- PORT EQU 0C0H ;your base port (data or status)
- ;
- MDCTL1 EQU PORT ;modem control port
- MDDATP EQU PORT+1 ;modem data port
- MDRCVB EQU 02H ;modem receive bit (DAV)
- MDRCVR EQU 02H ;modem receive ready
- MDSNDB EQU 01H ;modem send bit
- MDSNDR EQU 01H ;modem send ready bit
- ;
- ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- ; special equates for PMMI
- ;
- MDCTL2 EQU PORT+3 ;modem status port
- ;
- BAUDRP EQU PORT+2 ;modem baud rate port
- BRKMASK EQU 0FBH ;mask to set break
- EVPAMSK EQU 20H ;mask to set even parity
- NOPAMSK EQU 10H ;mask to reset to no parity
- ODPAMSK EQU 0CFH ;mask to set odd parity
- ;
- ANSWMOD EQU 1EH ;answer mode
- ORIGMOD EQU 1DH ;originate mode
- WAITCTS EQU 150 ;number of seconds (x5) to wait for the
- ;computer to answer after PMMI auto-dial
- ;100=20 sec, 150=30 sec, 255=51 seconds
- ;any number 0-255 acceptable
- ;
- ; (end of special PMMI equates)
- ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
- ;
- YES EQU 0FFH
- NO EQU 0
- ;
- BUFSIZ EQU 16 ;buffer size in Kbytes for ASCII capture to disk
- ;(16k is one file extent)
- XFRSIZ EQU 4 ;file transfer buffer in Kbytes. Do not make
- ;any larger than BUFSIZ. 16k works fine on all
- ;but very slowest systems
- ;
- BDNMCH EQU 75H ;bad name match
- ERRLIM EQU 10 ;maximum allowable consecutive errors
- ERRCRC EQU 6 ;CRC tries, then switches to CHECKSUM
- LIBLEN EQU 34 ;length of each phone library entry
- SHOWHEX EQU YES ;yes, show both decimal and hex record counts
- ;no, show just decimal record count
- RUB EQU 7FH ;rub
- CRC EQU 'C' ;requests 'CRC' instead of 'CKSUM'
- ESC EQU '['-40H ;^[ = escape
- SOH EQU 'A'-40H ;^A = start of header
- EOT EQU 'D'-40H ;^D = end of text
- EXITCHR EQU 'E'-40H ;^E = exit character
- ACK EQU 'F'-40H ;^F = acknowledge
- OKNMCH EQU 'F'-40H ;^F = ok name match
- BELL EQU 'G'-40H ;^G = bell character
- BKSP EQU 'H'-40H ;^H = backspace
- LF EQU 'J'-40H ;^J = linefeed
- CR EQU 'M'-40H ;^M = carriage return
- XON EQU 'Q'-40H ;^Q = XON character
- XOFF EQU 'S'-40H ;^S = XOFF character
- NAK EQU 'U'-40H ;^U = not acknowledge
- CANCEL EQU 'X'-40H ;^X = cancel send or receive
- EOFCHAR EQU 'Z'-40H ;^Z = end of file
- ;
- ORG 0100H
- ;
- JMP START ;skip the data area below
- ;
- ; These routines and equates are at the beginning of the program so
- ; they can be patched by a monitor or overlay file without re-assembling
- ; the program.
- ;
- PMMIMD DB YES ;yes=PMMI modem
- AUTDIAL DB NO ;yes=Hayes-type autodial modem
- TCHPUL DB 'T' ;T=touch, P=pulse (autodial-only)
- CLOCK DB 40 ;clock speed in MHz x 10, 25.5 MHz max.
- ;2 MHz=20, 3.68 MH=37, 4 MHz=40, etc.
- MSPEED DB 1 ;sets display time for sending a file
- ;0=110 1=300 2=450 3=600 4=710
- ;5=1200 6=2400 7=4800 8=9600 9=19200
- BYTDLY DB 5 ;0=0 delay 1=10 ms 5=50 ms - 9=90 ms
- ;defaut time to send character in ter-
- ;minal mode file transfer for slow BBS
- CRDLY DB 5 ;0=0 delay 1=100 ms 5=500 ms - 9=900 ms
- ;default time for extra wait after CRLF
- ;in terminal mode file transfer
- NOFCOL DB 5 ;number of directory columns
- STUPTST DB NO ;yes=non-PMMI setup routine
- SCRNTST DB NO ;yes=if home cursor and clear screen
- ;routine at CLRSCR
- RETRY DB YES ;yes=reset the error limit to try again
- ;no=abort after 10 consecutive errors
- BACKUP DB NO ;yes=make .BAK file
- CRCDFLT DB YES ;yes=default to CRC checking
- ;no=default to Checksum checking
- TGLECRC DB YES ;yes=allow toggling of Checksum to CRC
- CONVRUB DB NO ;yes=convert rub to backspace
- TGLERUB DB YES ;yes=allow toggling of rub to backspace
- ADDLFD DB NO ;no=no LF after CR to send file in
- ;terminal mode (added by remote echo)
- TGLELF DB YES ;yes=allow toggling of LF after CR
- TRANLOG DB NO ;yes=allow transmission of logon
- ;write logon sequence at location LOGON
- SAVCCP DB YES ;yes=do not overwrite CCP
- LOCNXT DB NO ;yes=local cmd if EXTCHR precedes
- ;no=not local cmd if EXTCHR precedes
- TGLELOC DB YES ;yes=allow toggling of LOCNXT
- LSTTST DB YES ;yes=allow toggling of printer on/off
- ;in terminal mode. Set to no if using
- ;the printer port for the modem
- XOFFTST DB NO ;yes=allow testing of XOFF from remote
- ;while sending a file in terminal mode
- XONWAIT DB NO ;yes=wait for XON after sending CR while
- ;transmitting a file in terminal mode
- TGXOFF DB YES ;yes=allow toggling of XOFF testing
- IGNRCTL DB NO ;yes=do not send control characters
- ;above CTL-M to CRT in terminal mode
- ;no=send any incoming CTL-char to CRT
- EXTRA1 DB 0 ;for future expansion
- EXTRA2 DB 0 ;for future expansion
- BRKCHR DB '@'-40H ;^@ = Send a 300 ms. break tone
- NOCONCT DB 'N'-40H ;^N = Disconnect from phone line
- LOGCHR DB 'L'-40H ;^L = Send logon
- LSTCHR DB 'P'-40H ;^P = Toggle printer
- UNSAVCH DB 'R'-40H ;^R = Close input text buffer
- TRANCHR DB 'T'-40H ;^T = Transmit file to remote
- SAVECHR DB 'Y'-40H ;^Y = Open input text buffer
- EXTCHR DB '^'-40H ;^^ = Send next character
- ;
- ; Equates used only by PMMI routines grouped together here
- ;
- PULRATE DB 250 ;125=20pps dialing, 250=10pps
- CHGBAUD DB 'B'-40H ;^B = Used with PMMIMD in terminal
- ;mode to change baud rate on fly
- ;
- ; Handles in/out ports for data and status
- ;
- I$MDCTL1 IN MDCTL1 ! RET ;in modem control port
- DB 0,0,0,0,0,0,0 ;spares if needed for non-PMMI
- ;
- O$MDDATP OUT MDDATP ! RET ;out modem data port
- DB 0,0,0,0,0,0,0 ;spares if needed for non=PMMI
- ;
- I$MDDATP IN MDDATP ! RET ;in modem data port
- DB 0,0,0,0,0,0,0 ;spares if needed for non-PMMI
- ;
- A$MDRCVB ANI MDRCVB ! RET ;bit to test for receive ready
- C$MDRCVR CPI MDRCVR ! RET ;value of receive bit when ready
- A$MDSNDB ANI MDSNDB ! RET ;bit to test for send ready
- C$MDSNDR CPI MDSNDR ! RET ;value of send bit when ready
- ;
- ;====================== SPECIAL PMMI PORTS =============================
- ;
- I$BAUDRP IN BAUDRP ! RET ;in baudrate port
- O$BAUDRP OUT BAUDRP ! RET ;out baudrate port
- O$MDCTL1 OUT MDCTL1 ! RET ;out modem control port #1
- O$MDCTL2 OUT MDCTL2 ! RET ;out modem control port #2
- ;
- LOGONPTR DW LOGON
- J$DIAL JMP DIAL
- J$DSCONT JMP DSCONT
- J$GOODBY JMP GOODBY
- J$INITMD JMP INITMD
- J$NWBAU JMP NWBAU
- J$NPARIT JMP NPARIT
- J$PRITY JMP PRITY
- J$STUPR JMP STUPR
- J$SPMEN JMP SPMEN
- J$SYSVR JMP SYSVR
- J$BREAK JMP SNDBRK
- ;
- ; Next six lines should not be changed by user overlay as these go to
- ; specific locations in the main program, not in the overlay.
- ;
- J$ILPRT JMP ILPRT
- J$INBUF JMP INBUF
- J$INLNCP JMP INLNCP
- J$INMDM JMP INMDM
- J$NXTSCR JMP NXTSCR
- J$TIMER JMP TIMER
- ;
- ; Clear sequences are for Televideo, Lear Siegler, etc. Change to match
- ; your terminal. (Heath uses ESC 4AH for clear to end of screen, ESC 45H
- ; to clear screen. Lear Siegler and others use ESC 79H for clear to end
- ; of screen and ESC 3AH to clear screen.) Room allowed for four bytes.
- ; (Last zero needed for stopping the string display. Any extra 0's just
- ; act as NOP's.)
- ;
- CLREOS CALL J$ILPRT
- DB ESC,79H,0,0,0
- RET
- ;
- CLRSCR CALL J$ILPRT
- DB ESC,3AH,0,0,0
- RET
- ;
- ;======================= SIGN-ON MESSAGE ==============================
- ;
- ; Send version number and date
- ;
- SYSVR LDA PMMIMD ;using the PMMI S-100 modem?
- ORA A
- JZ SYSVR1 ;go if not
- CALL J$ILPRT
- DB 'Version for PMMI S-100 modem starting at port: ',0
- LDA I$MDCTL1+1
- CALL HEXO ;put in PMMI control port number
- CALL J$ILPRT
- DB 'H',CR,LF,0
- RET
- ;
- SYSVR1 CALL J$ILPRT ;if not using the PMMI S-100 board
- DB 'Version for Non-PMMI modem',CR,LF,0
- RET
- ;
- ;==================== LOGON MESSAGE (IF ANY) ===========================
- ;
- ; Insert your logon message here. End with a 0 (for"CALL ILPRT").
- ; PMMIusers have 59 bytes available, non-PMMI users have approximately
- ; 2K bytes available as they can overwrite all the following PMMI rou-
- ; tines if they wish. This method allows the external overlays to have
- ; plenty of room. It keeps the phone number library at a fixed location.
- ;
- LOGON DS 59 ;up to 59 characters allowed
- DB 0 ;to terminate the logon message
- ;
- ;=============== NON-PMMI INITIALIZATION (IF ANY) ======================
- ;
- ; Insert your initialization routine here if needed. Can replace the
- ; following special PMMI area to set speed and auto-dial. Over 950
- ; bytes are available for this purpose. (End your routine with a RET.)
- ;
- INITMD RET
- ;
- ;========== NON-PMMI SETUP (SPEED CHANGE, ETC.) IF ANY ==============
- ;
- ; Insert your speed change and/or auto-dialing routines here. Over 950
- ; bytes are available (INCLUDING INITMD, above). End your routine with
- ; a RET.
- ;
- STUPR RET
- ;
- ; Not needed if using the PMMI board, as it has its own break routine
- ;
- SNDBRK RET
- ;
- ;**************** START OF SPECIAL PMMI ROUTINES **********************
- ;
- ;=======================================================================
- ; SETS THE BAUD RATE
- ;=======================================================================
- ;
- STBAUD LDA ANSWFLG ;if 'O' or 'A' not requested and
- ORA A ; baudrate not specified, returns
- JZ FXBAUD ; with current mode and rate
- LDA ORIGFLG ;if option requested, a blank returns
- ORA A ; with current mode and rate
- RNZ ;no change if neither 'O' or 'A' shown
- ;
- FXBAUD CALL GTBAUD ;calculate PMMI baud rate divisor
- CALL STMSPD ;set the file time transfer value
- CALL O$BAUDRP ;set the PMMI board to that baudrate
- CPI 52
- MVI A,5FH ;DTR (filter for over 300 baud)
- JC GT300 ;yes, greater than
- MVI A,7FH ;DTR (filter for 300 and less baud)
- ;
- GT300 CALL O$MDCTL2
- STA MDCTLB ;save modem control byte
- ;
- OFHOOK LXI H,7500 ;throw in some delay
- ;
- OFFDLY DCR L
- JNZ OFFDLY
- DCR H
- JNZ OFFDLY
- LDA UARTCT ;UART control byte for 'A' or 'O'
- CALL O$MDCTL1 ;now set to answer or originate
- MOV A,C
- STA MSPEED ;set the file transfer time value
- XRA A ;clear the flags
- RET
- ;
- ;=======================================================================
- ; CALCULATES THE BAUD RATE DIVISOR
- ;
- ; Returns with current baud rate intact if a blank or null in the speed
- ; field (extent area).
- ;
- GTBAUD LDA FCB+9 ;get 1st digit of requested baudrate
- CPI ' ' ;if a space, return with current speed
- LDA CURRENT
- RZ
- LDA FCB+9
- ORA A ;if a null, return with current speed
- LDA CURRENT
- RZ
- ;
- LXI D,FCB+9 ;get the requested speed
- LXI H,0
- ;
- DECLP LDAX D ;get the ASCII digit
- INX D
- CPI ' '
- JZ DECLP
- CPI '0' ;numerals are 0-9
- JC BADRTE
- CPI '9'+1
- JNC BADRTE
- SUI '0'
- MOV B,H
- MOV C,L
- DAD H
- DAD H
- DAD B
- DAD H
- ADD L
- MOV L,A
- JNZ DIGNC
- INR H
- ;
- DIGNC MOV A,E
- CPI FCB+12
- JNZ DECLP
- MOV A,H
- CMA
- MOV D,A
- MOV A,L
- CMA
- MOV E,A
- INX D
- LXI H,15625 ;250000/16
- LXI B,-1
- ;
- DIVLP INX B
- DAD D
- JC DIVLP
- MOV A,B
- ORA A
- MOV A,C
- STA CURRENT ;can use this the next time by default
- RZ
- ;
- BADRTE CALL ERXIT
- DB '++ INVALID BAUDRATE ++$'
- ;
- ;=======================================================================
- ; SETS 'MSPEED' TO BAUD RATE
- ;
- STMSPD MVI C,0 ;changes PMMI mspeed for 110-710 bps
- CPI 100 ;<300 bps
- RNC
- INR C ;C=1 for 300 bps
- CPI 40 ;<450 bps
- RNC
- INR C ;C=2 for 450 bps
- CPI 30 ;<600 bps
- RNC
- INR C ;C=3 for 600 bps
- CPI 24 ;<710 bps
- RNC
- INR C ;C=4 for 710 bps
- RET
- ;
- ; Change baudrate on-the-fly with CTL-B (while in terminal mode)
- ;
- NWBAU LDA PMMIMD
- ORA A
- RZ
- CALL J$ILPRT
- DB CR,LF,'Enter new Baudrate: ',0
- LXI H,FCB+9
- MVI M,' ' ;keep current baud if none included
- ;
- NWBAU1 CALL KEYIN ;get the baud rate
- CPI CR ;carriage ret finishes baud rate entry
- CZ CRLF ;if a 'CR', baud rate has been entered
- JZ FXBAUD ;go change the baud rate
- ;
- NWBAU2 CPI '0' ;numerals are 0-9
- JC NWBAU1
- CPI '9'+1
- JNC NWBAU1 ;if not a numeral, ignore, ask again
- MOV M,A ;store answer starting at FCB+9
- CALL TYPE ;show the numeral on the CRT
- INX H ;next storage location in FCB
- JMP NWBAU1 ;get the next numeral
- ;
- ;======================= PARITY ROUTINES ===============================
- ;
- ;--->PRITY: Routine to setup PMMI for odd/even parity.
- ;
- PRITY LDA PMMIMD ;is modem a PMMI?
- ORA A ;set flags
- RZ ;no, return
- LDA OPRITY ;get odd parity request byte
- ORA A ;set flags
- JNZ EVNPAR ;if not odd see if it is even
- LDA UARTCT ;get uart/modem control byte
- ANI ODPAMSK
- JMP PRITY1
- ;
- EVNPAR LDA EPRITY ;get even parity request byte
- ORA A ;set flags
- RNZ ;if even parity not specified return
- LDA UARTCT ;get uart/modem control byte
- ANI ODPAMSK ;set for parity
- ORI EVPAMSK ;now set for even parity
- ;
- PRITY1 STA UARTCT
- JMP O$MDCTL1 ;send to PMMI
- ;
- NPARIT LDA PMMIMD
- ORA A
- RZ
- LDA UARTCT
- ORI NOPAMSK ;reset parity bit on PMMI
- JMP O$MDCTL1
- ;
- ;=======================================================================
- ; HAYES/PMMI DIALING ROUTINES
- ;=======================================================================
- ;
- DS 128 ;for expansion
- ;
- ; Modem control command words
- ;
- BRKMSK EQU 0 ;tele line on hook (break while dialing)
- CLEAR EQU 3FH ;idle mode
- DTMSK EQU 1 ;dial tone mask
- MAKEM EQU 1 ;tele line make (off hook)
- RBLMT EQU 35 ;7 seconds to wait til no-ring-heard msg
- RBWAIT EQU 50 ;5 second delay before redialing PMMI
- SMWAIT EQU 15 ;1.5 sec delay before redialing HAYES
- TMPUL EQU 80H ;timer pulses mask bit
- TRATE EQU 250 ;value for 0.1 second
- ;
- ; Dialing routine
- ;
- DIAL LDA PMMIMD ;using a PMMI modem?
- ORA A
- JNZ DIAL1
- LDA AUTDIAL
- ORA A
- RZ ;return if neither modem
- CALL SMNSY ;make sure autodial modem speaker is on
- ;
- DIAL1 XRA A
- STA AUTDIR ;zero the direct to terminal mode flag
- STA AUTOFL ;zero the auto-linking flag
- STA CRFLAG ;zero the continuous dial flag
- LXI H,0
- SHLD DIALCT ;zero the dial count
- LXI H,CMDBUF+1 ;point to the number of characters in
- MOV A,M ; the buffer, then get the number
- CPI 3+1 ;anything typed after 'CAL'?
- JC DIAL2 ;if not, go through library routine
- ;
- ; If there were only 3 characters, then "CAL<RET>" was typed -- the user
- ; obviously expecting to get a phone number (or letter) from the library
- ; file. If 4 or more, a number (or letter) was typed in from the menu
- ; command line, so move the characters down 4 to compensate. Needed for
- ; auto-redialing of menu command line entries.
- ;
- MOV C,A ;put into the 'C' reg.
- MVI B,0 ;will move original number down 4
- SUI 4 ;eliminate the 'CAL' portion
- MOV M,A ;store new count at cmdbuf+1
- INX H ;CMDBUF+2 (first character of string)
- XCHG ;'DE' now has CMDBUF+2
- LXI H,CMDBUF+6 ;point to number (or letter) to dial
- CALL MOVER ;move the group down 4 places
- JMP DIAL4 ;check if library number, then dial
- ;
- ; Comes here if no phone number was manually entered after 'CAL' and if
- ; no phone library code was entered. Displays the phone number library
- ; then asks for an entry.
- ;
- DIAL2 MVI C,18 ;number of lines to move
- LXI H,NUMLIB ;start of phone number library
- LXI D,BUFFER ;buffer add. to store them temporarily
- CALL NEWLINE ;start with CR/LF
- STAX D ;+LF
- INX D ;and bump it
- ;
- DIAL3 MVI B,LIBLEN ;number of bytes to move
- CALL MOVE ;move to buffer
- CALL SPACES ;2 entries + 3 spaces = 71 characters
- PUSH H ;save source address
- PUSH D ;save destination address
- LXI D,(17*LIBLEN) ;get offset of 17 times entry length
- DAD D ;add it to source address
- POP D ;restore destination address
- MVI B,LIBLEN ;get length of library entry
- CALL MOVE ;move another entry
- POP H ;restore source address
- CALL NEWLINE
- DCR C ;one less line to print
- JNZ DIAL3 ;if not zero, print another
- MVI A,'$' ;BDOS print routine terminate character
- STAX D ;store in buffer
- CALL CLRTST
- MVI C,PRINT
- LXI D,BUFFER ;print the library on the CRT
- CALL BDOS
- CALL J$ILPRT ;ask which one is wanted
- DB CR,LF,'Enter library code or phone number,',CR,LF
- DB 'Hit RET to abort this function now or',CR,LF
- DB 'CTL-X quits while dialing or ringing: ',0
- LXI D,CMDBUF
- CALL INBUF ;get the answer from the keyboard
- ;
- ; You now have either a library code or a manually entered phone num-
- ; ber. These either came from the menu command line or from the library
- ; command line. Next we see if a code, if so, get the corresponding
- ; line with phone number from the library. If a number greater than
- ; one digit, we ignore the library look-up. (Ringback numbers must end
- ; with letter 'R'.)
- ;
- DIAL4 LXI H,CMDBUF+1 ;number of characters in buffer
- MOV A,M
- ORA A ;null means CR was typed
- JZ DLXIT2 ;abort dialing, return to menu
- STA NUMBER
- LDA CMDBUF+3 ;see if at least two characters entered
- CPI '/' ;slash for linking, direct to terminal
- CZ AUTO ; mode on answer
- CPI ',' ;comma used for linking
- CZ AUTO1 ;if yes, set it up for auto-linking
- ;
- ; Check to see how many characters were typed. If more than one, then
- ; it was a hand-entered phone number, so exit.
- ;
- DIAL5 CALL DIALBG ;disconnect, reconnect
- LDA AUTOFL ;auto-link flag set?
- ORA A
- JNZ AUTO2 ;if yes exit
- LDA NUMBER ;number of characters in buffer
- STA CMDBUF+1 ;reset the character count, if needed
- CPI 1+1 ;more than one character?
- JNC DIAL14 ;if more than one, hand-entered number
- LXI H,CMDBUF+2 ;first character in phone number line
- ;
- ; If just one character entered, see if a (A-Z) letter
- ;
- DIAL6 MOV A,M
- MVI B,'A' ;first letter of alphabet
- MVI E,0 ;counts number of letters to match
- MVI C,26 ;number of letters in alphabet
- ;
- DIAL7 CMP B ;letter from table?
- JZ DIAL9 ;if yes, get phone number, else
- INR B ;make next letter (A-Z)
- INR E ;count up
- DCR C ;count down
- JNZ DIAL7 ;try next one in (A-Z) table
- ;
- ; If not (A-Z) then should be (0-9)
- ;
- MVI B,'0' ;first digit to check
- MVI E,26 ;point past alpha codes
- MVI C,10 ;number of digits in table
- ;
- DIAL8 CMP B ;number from table?
- JZ DIAL9 ;if yes, go dial, else
- INR B ;make next digit to compare
- INR E ;make next table line number
- DCR C ;count down - loop counter
- JNZ DIAL8 ;loop
- JMP DIALBD ;error if not a number or a letter
- ;
- ; Now have a match between the requested code and one in the library.
- ; E-reg. holds the library line number (1-36) that matches the requested
- ; code (A-Z or 0-9).
- ;
- DIAL9 LXI H,NUMLIB ;phone number library
- LXI B,LIBLEN ;length of library entry
- MOV A,E ;number of times to library length to HL
- ORA A ;set flags
- JZ DIAL11
- ;
- DIAL10 MOV A,M ;get first char of selected lib entry
- ORA A ;set flags
- JZ DIALBD ;send bad library msg and abort
- DAD B ;increment 'HL' by library length
- DCR E ;countdown
- JNZ DIAL10 ;not there yet, loop
- ;
- ; Now have the line in the phone number library matching the requested
- ; letter so store that line starting at 'CMDBUF+1'
- ;
- DIAL11 MVI B,LIBLEN ;number of characters to get from table
- LXI D,CMDBUF+1 ;point to buffer
- XCHG ;'HL' points to CMDBUF+1
- MOV M,B ;length of each table entry
- XCHG ;restore the registers
- INX D ;point to first char position in buffer
- CALL MOVE ;move the table entry to the buffer
- ;
- ; Now have the full line including phone number in 'CMDBUF' area. Scan
- ; past the descriptive portion of library entry - terminate scan at the
- ; first '.' This allows commas and numbers to be part of the text, such
- ; as:
- ; 'A=DataTech, Node 7..1-408-238-9621'
- ;
- DIAL12 LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- CNZ SMINIT ;if yes, initialize
- LXI H,CMDBUF+1
- MOV E,M ;number of chars in buffer
- INX H ;point to 1st character in buffer
- ;
- DIAL13 MOV A,M ;get next character
- CALL TYPE ;show it
- INX H ;bump pointer
- DCR E ;decrement count
- JZ DLXIT ;exit if no '.' (bad library entry)
- CPI '.' ;dot?
- JZ DIAL15 ;yes, go dial the phone
- JMP DIAL13 ;no, loop for next character
- ;
- ; There is a user entered phone number in 'CMDBUF' area
- ;
- DIAL14 LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- CNZ SMINIT ;if yes, initialize
- LXI H,CMDBUF+1 ;get the number of characters in buffer
- MOV A,M
- MOV E,M
- INX H ;point to 1st character to dial
- ;
- ; Loop to dial the phone number pointed to by 'HL', character count in
- ; the 'E' register.
- ;
- DIAL15 MOV A,M ;get first number from the buffer
- ORA A ;set flags
- JZ DIALBD ;bad number if a null
- ;
- ; Dial a digit, check keyboard for abort
- ;
- CALL DL ;dial a digit, show on CRT
- CALL STAT ;keypress?
- JZ DIAL17 ;if not, exit
- CALL KEYIN ;yes, go get it
- CPI CANCEL ;CTL-X?
- JNZ DIAL17 ;if not, exit
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ DLXIT ;if not, exit now, otherise clear line
- ;
- ; If using an autodial modem, backspace 30 tims to make sure the entire
- ; number plus 'DT' part of 'ATDT' is erased.
- ;
- MVI C,30
- ;
- DIAL16 MVI B,BKSP
- CALL SNDCHR ;send to the modem to cancel call
- DCR C
- JNZ DIAL16 ;if not zero, do another
- MVI B,CR
- CALL SNDCHR
- MVI A,' '
- CALL TYPE ;show on CRT
- JMP DLXIT ;now go abort
- ;
- DIAL17 INX H ;bump pointer
- DCR E ;one less character to go
- JNZ DIAL15 ;if not done, send the next digit
- ;
- ; Show the number of dial attempts
- ;
- CALL J$ILPRT
- DB ' - try #',0
- LHLD DIALCT ;increment the dial count
- INX H
- SHLD DIALCT
- CALL DECOUT ;show number of attempts so far
- MVI A,' ' ;extra space to position cursor
- CALL TYPE
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ DIAL19 ;if not, exit
- MVI B,CR ;tells the modem the number is done
- CALL SNDCHR ;just have one character to send
- ;
- DIAL18 CALL J$INMDM ;catch any output from the modem
- JNC DIAL18
- JMP SMRSLT ;number sent to modem, now get results
- ;
- ; Dialing is all done, this section is PMMI-only
- ;
- DIAL19 MVI A,07FH ;turn on PMMI 'DTR'
- CALL O$MDCTL2 ;timer rate?
- MVI B,1 ;0.1 second per interval
- CALL J$TIMER
- MVI A,5DH ;2 stop bits, nor parity, 8 data bits
- CALL O$MDCTL1
- MVI D,4 ;clear to send mask
- MVI C,WAITCTS ;wait time for CTS
- CALL WAIT ;(30 seconds, can set 'WAITCTS' for
- ;up to 51 seconds for European use)
- ;
- ; If PMMI connection made, go get options for starting communications
- ;
- JNC CONMD ;connection made
- ;
- ; Connection not made, see if a redial is desired
- ;
- ; CALL DSCONT ;hang-up so we can redial
- ;
- DLGN LXI SP,STACK ;reset the stack to normal, just in case
- LDA CRFLAG ;continuous redial flag
- ORA A
- JNZ DLGN2 ;if already set, go dial again
- CALL J$ILPRT ;see if we should keep trying
- DB CR,LF,CR,LF,' Redial? (C/Y/N/Q): ',BELL,0
- CALL KBDCHR
- CALL CRLF ;turn up a line
- CPI 'Y' ;redial?
- JZ DLGN2 ;yes, redial
- CPI 'C' ;continuous redial?
- JZ DLGN1 ;if yes, set continuous redial flag
- CPI 'Q'
- JNZ DLXIT1 ;none of these, quit
- CALL SMQT ;turn off the loud speaker for 'Quiet'
- ;
- DLGN1 MVI A,1
- STA CRFLAG ;continuous redial flag
- ;
- DLGN2 LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JNZ DLGN3 ;if yes, exit
- MVI B,RBWAIT ;wait for PMMI reset (or busy)
- CALL J$TIMER ;or busy tone may be sensed as dialtone
- JMP DLGN4
- ;
- DLGN3 MVI B,SMWAIT
- CALL J$TIMER
- ;
- DLGN4 CALL CRLF ;start a new line
- JMP DIAL5 ;redial entry point
- ;
- ; Connection has been made
- ;
- CONMD LDA PMMIMD
- ORA A
- JZ CONMD1
- LDA CURRENT ;get curret baud rate
- CALL O$BAUDRP ;set baudrate
- ;
- CONMD1 MVI B,2
- CALL J$TIMER
- CALL J$ILPRT
- DB BELL,CR,LF,CR,LF,' CONNECTED',0
- LDA AUTDIR ;going direct to terminal mode?
- ORA A
- JNZ RETRN
- LDA CRFLAG ;in continuous redial or first time try?
- ORA A
- JZ RETRN ;go to terminal mode if first time
- CALL J$ILPRT
- DB ' - any key for terminal mode ',0
- ;
- CONMD2 MVI E,10
- ;
- CONMD3 CALL STAT ;keypress?
- JZ CONMD4 ;exit if no keys pressed
- CALL KEYIN
- XRA A
- JMP RETRN ;key pressed, go to terminal mode
- ;
- CONMD4 MVI B,1 ;wait 0.1 second
- CALL J$TIMER
- DCR E ;one less loop to make
- JNZ CONMD3 ;see if a keyboard character yet
- MVI A,BELL ;sound a bell
- CALL TYPE
- JMP CONMD2 ;reset the counter
- ;
- ; Automatic dialing routine, prints the number being dialed. If we find
- ; 'R', it either has to be the final character for ringback or toss it.
- ;
- DL CALL TYPE ;print whatever character, dashes, etc.
- CPI 'R' ;could it be a ringback character?
- JNZ DL1 ;if not, probably a number so exit
- MOV A,E ;get the character count. Is this "R"
- CPI 1 ; the last character in the string?
- JZ RNGBK ;if yes, set up ringback
- RET ;if not, ignore the 'R'
- ;
- DL1 MOV B,A ;store the character for now
- CALL DLD ;check for alternate dialing like 'MCI'
- MOV A,B ;get the original character back
- ;
- DL2 CPI '*' ;* is a valid dial digit
- JZ DL3
- CPI '#' ;# is a valid dial digit
- JZ DL3
- CPI ',' ;comma indicates a short delay-time
- JZ DL3
- CPI '0' ;digits are (0-9)
- RC ;exit less than ASCII '0'
- CPI '9'+1
- RNC ;exit if more than ASCII '9'
- SUI '0' ;strip ASCII - could also do 'ANI 0FH'
- JNZ DL3
- MVI A,10 ;convert zero to 10 pulses
- ;
- ; Sends the digit to the modem. Waits 100 ms. after each digit to in-
- ; sure it gets to the modem ok.
- ;
- DL3 MOV C,A
- LDA PMMIMD ;using a PMMI?
- ORA A
- JNZ DL4 ;if yes, exit
- CALL SNDCHR ;character is already in the 'B' reg.
- MVI B,1 ;slight delay to let modem settle down
- JMP J$TIMER
- ;
- DL4 LDA PULRATE
- CALL O$BAUDRP
- ;
- DL5 CALL I$BAUDRP
- ANI TMPUL
- JNZ DL5
- ;
- DL6 CALL I$BAUDRP
- ANI TMPUL
- JZ DL6
- ;
- DL7 MVI A,MAKEM
- CALL O$MDCTL1
- ;
- DL8 CALL I$BAUDRP
- ANI TMPUL
- JNZ DL8
- MVI A,BRKMSK
- CALL O$MDCTL1
- ;
- DL9 CALL I$BAUDRP
- ANI TMPUL
- JZ DL9
- DCR C
- JNZ DL7
- MVI A,MAKEM
- CALL O$MDCTL1
- MVI B,2
- JMP J$TIMER
- ;
- ; Print bad library number message and abort if a null is encountered.
- ;
- DIALBD CALL J$ILPRT
- DB CR,LF,CR,LF,'++ Bad library number called ++',CR,LF,0
- ;
- DLXIT CALL CRLF ;turn up a new line
- ;
- DLXIT1 LXI SP,STACK ;make sure the stack is normal again
- ;;; CALL J$GOODBY ;user routine to disable DTR, if any
- DB 0,0,0 ;(PREVENT DOUBLE TIME FOR DISCONNECT)
- CALL J$DSCONT ;hang up the phone and reset the modem
- ;
- DLXIT2 XRA A
- STA CRFLAG ;reset the continuous redial flag
- JMP MENU
- ;
- ; Disconnect from the line, reconnect and wait for the dialtone.
- ;
- DIALBG LDA AUTDIAL ;Hayes-type autodial modem?
- ORA A
- RNZ ;if yes, finished
- MVI A,MAKEM ;go off-hook
- CALL O$MDCTL1
- MVI D,DTMSK ;dial tone mask
- MVI C,50 ;waits up to 10 seconds for dial tone
- CALL WAIT ;wait for dial tone
- ;
- ; Wait subroutine will return with carry set if unable to get dialtone.
- ; If carry is not set, the dialtone was received.
- ;
- RNC ;if dial tone within 10 seconds
- CALL J$ILPRT ;otherwise print error message
- DB CR,LF,CR,LF,'++ NO DIAL TONE ++ ',BELL,0
- POP H ;restore the stack to normal
- JMP DLXIT ;forget it.
- ;
- ; Do any alternate dialing such as 'MCI' or 'SPRINT'
- ;
- DLD LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- RZ ;if not, exit
- LDA TCHPUL ;using touch tone dialing?
- CPI 'T'
- RNZ ;if not, ignore
- MOV A,B ;get the character back
- CPI '<' ;alternate dialing system #1 (MCI?)
- JNZ DLD1 ;if not, exit
- PUSH H ;save the current values
- LXI H,ALTDL1 ;alternate dialing area
- JMP DLD2
- ;
- DLD1 CPI '>' ;alternate dialing system #2 (Sprint?)
- RNZ ;if neither, exit
- PUSH H ;save the current values
- LXI H,ALTDL2
- ;
- DLD2 MOV A,M
- CPI '$' ;ready to terminate?
- JZ DLD3 ;if yes, exit
- ;
- ; Move the semicolons up one line if you do not want to see the Sprint
- ; number dialed.
- ;
- CALL TYPE ;display the character
- ;;; DB 0,0,0 ;(keeps the total bytes similar)
- MOV B,A ;need the char. in 'B' to send to modem
- CALL DL2 ;send proper characters to the modem
- INX H ;next location
- CALL STAT ;keypress?
- JZ DLD2 ;if not, do the next character
- CALL KEYIN ;yes, go get it
- CPI CANCEL ;CTL-X?
- JNZ DLD2 ;if not, handle the next character
- POP H ;if yes, reset the stack
- JMP DLXIT ;if yes, exit
- ;
- DLD3 MVI A,' '
- MOV B,A ;clears 'B' from last digit sent
- CALL TYPE
- POP H ;restore the stack
- RET
- ;
- ; Disconnect the autodial modem from the phone line. Sends 'I, CR' to
- ; the Racal-Vadic to return to IDLE mode
- ;
- GOODBY
- DSCONT LDA AUTDIAL ;using a Hayes-type autodial modem?
- ORA A
- JNZ DSCON1 ;if yes, skip PMMI section
- XRA A
- CALL O$MDCTL1 ;hang up
- CALL O$MDCTL2 ;clear DAV, ESD, etc.
- PUSH B
- MVI B,10 ;1 second for PMMI to disconnect
- CALL J$TIMER
- POP B
- RET
- ;
- ; Disconnect the autodial modem from the phone line
- ;
- DSCON1 MVI B,12 ;1.2 seconds pause
- CALL J$TIMER
- LXI H,SM$DISC ;get into command mode
- CALL SNDOUT
- MVI B,12 ;another 1.2 seconds pause
- CALL J$TIMER
- MVI A,' ' ;space character
- ;
- ; If printing +++ and ATH, ATD, etc. move the three semicolons up one
- ; line to include a space on the CRT to look better.
- ;
- DB 0,0,0
- ;;; CALL TYPE ;show on local CRT only
- LXI H,SM$DISC1 ;now disconnect the modem
- CALL SNDOUT
- ;
- DSCON2 CALL J$INMDM ;wait 0.1 seconds after last character
- JNC DSCON2
- RET
- ;
- ;-----------------------------------------------------------------------
- ; Hayes Stuff
- ;
- SMQT LDA SPKRFLG ;speaker flag set to quiet?
- ORA A
- RNZ ;if yes, forget it
- MVI A,YES
- STA SPKRFLG ;flip the flag to quiet, now
- LXI H,SM$SOFF
- CALL SNDOUT
- MVI B,6
- JMP J$TIMER ;time for an 'OK' from modem and return
- ;
- SMNSY LDA SPKRFLG ;speaker already turned on?
- ORA A
- RZ ;if yes, forget it
- MVI A,NO ;set for noisey, now
- STA SPKRFLG
- LXI H,SM$SON
- CALL SNDOUT
- MVI B,6
- JMP J$TIMER
- ;
- ; Hayes-like autodial modem control codes
- ;
- SM$DIAL DB 'ATDT $' ;set for touch (or pulse) dialing
- SM$DISC DB '+++$' ;puts the modem in local command mode
- SM$DISC1 DB 'ATH',CR,'$' ;disconnects the modem
- SM$SOFF DB 'ATM0',CR,'$' ;turns the speaker off
- SM$SON DB 'ATM1',CR,'$' ;turns the speaker on
- SPKRFLG DB 0 ;0 = speaker has not been silenced
- ;
- ; Set the autodial modem for pulse dialing
- ;
- SMINIT LDA TCHPUL ;touch or pulse dialing for autodial?
- STA SM$DIAL+3 ;store
- LXI H,SM$DIAL
- CALL SNDOUT
- ;
- SMINT1 CALL J$INMDM ;wait for modem to finish, if needed
- JNC SMINT1
- RET
- ;
- ; Send the string pointed to by 'HL' to both the CRT and the modem
- ;
- SNDOUT CALL SNDNOW ;wait until modem is ready
- MOV A,M ;get the character
- CPI '$'
- RZ ;if yes, finished
- MOV A,M
- CALL O$MDDATP ;send to modem
- ;
- ; If you want to print the +++ ATD, etc. from Hayes-type units, move the
- ; three semi-colons down one line.
- ;
- ;;; CALL TYPE ;show on CRT
- DB 0,0,0 ;(PREVENT SHOWING THE +++ ATD)
- INX H
- JMP SNDOUT
- ;
- ; Checks for answer from Hayes-type autodial modem
- ;
- SMRSLT CALL RCVRDY ;see if any incoming character yet
- JZ SMRSL1 ;if yes, exit and look at it
- CALL STAT ;else see if want to abort ringing
- JZ SMRSLT ;if neither, wait for one of them
- CALL KEYIN ;get character from keyboard
- CPI CANCEL ;CTL-X to terminate dialing?
- JNZ SMRSLT ;if not, keep going
- MVI B,CR
- CALL SNDCHR ;tells the modem to hang up right away
- JMP DLXIT ;abort dialing routine
- ;
- SMRSL1 CALL I$MDDATP ;get the character, then
- ANI 7FH ;remove any parity
- MOV B,A ;store for 'GIVLF' area if needed
- CPI 'B' ;'BUSY' (for Anchor modems, etc.)
- JZ BUSY ;if busy, flush string and retry
- CPI '0' ;'OK' single digit result code
- JZ SMRSL1 ;ok, loop for next response
- CPI 'O' ;'OK' verbose digit result coe
- JZ SMRSL1 ;ok, loop for next response
- CPI '1' ;'CONNECT', single digit result code
- JZ ON$LIN ;connected, reset redial flags
- CPI 'C' ;'CONNECT', verbose result code
- JZ ON$LIN ;connected, reset redial flags
- CPI '3' ;'NO CARRIER', single digit result code
- JZ NO$CAR ;no carrier, flush string and retry
- CPI 'N' ;'NO CARRIER', verbose result code
- JZ NO$CAR ;no carrier, flush string and retry
- CPI '4' ;'ERROR', single digit result code
- JZ FAILED ;error, go display
- CPI 'E' ;'ERROR', verbose result code
- JZ FAILED ;error, go display
- CPI '5' ;'CONNECT 1200' single digit result code
- JZ ON$120 ;connected, reset redial flags
- ;
- SMDM1 CPI LF ;<LF> is end-of-line for verbose mode
- JZ SMRSLT ;yes, go get the next response
- CPI CR ;<CR> may precede digit in digit mode
- JZ SMRSLT ;yes, go get the next response
- ;
- CALL STAT ;else, see if want to abort ringing
- JZ SMDM1A ;if not, get next character
- CALL KEYIN ;else, get character from keyboard
- CPI CANCEL ;CTL-X to terminate dialing?
- JNZ SMDM1A ;if not, keep going
- MVI B,CR
- CALL SNDCHR ;tells the modem to hang up right away
- JMP DLXIT ;abort dialing routine
- ;
- SMDM1A CALL J$INMDM ;get next character
- JMP SMDM1 ;loop until end of response encountered
- ;
- ; The Anchor modem gives a busy result code, although still waits the
- ; normal time-out period to do it.
- ;
- BUSY CALL J$ILPRT
- DB 'busy! ',0
- JMP DLGN
- ;
- ; Failed call is usually caused by continuous ringing with no answer.
- ; The modem times out (can be set to either 30 seconds or 60 seconds.)
- ;
- FAILED CALL J$ILPRT
- DB 'abort ',0
- JMP DLGN
- ;
- NO$CAR CALL J$ILPRT
- DB 'no carrier ',0
- JMP DLGN
- ;
- ON$LIN CALL J$ILPRT
- DB 'on line',0
- JMP CONMD
- ;
- ON$120 CALL J$ILPRT
- DB 'on at 1200',0
- JMP CONMD
- ;
- ; end of special Hayes-like handling
- ;-----------------------------------------------------------------------
- ;
- ; Handles the special ringback numbers. Dials, lets it ring only once,
- ; hangs up and then redials.
- ;
- RNGBK LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JNZ RNGBK2 ;if yes, ringback not possible
- LDA CMDBUF+1 ;get the number of chars. in the buffer
- DCR A ;subtract 1 to avoid the ringback char
- STA CMDBUF+1 ;store the new value
- MVI D,DTMSK ;load tone detect mask
- MVI C,RBLMT ;waits up to 7 seconds for a ring
- CALL WAIT
- JNC RNGBK0 ;if no ring detected, pretend we got one
- JMP RNGBK1 ;hangup, redial, & listen for carrier
- ;
- RNGBK0 MVI B,25 ;got a ring, wait 2.5 seconds
- CALL TIMER
- CALL I$BAUDRP ;is tone still present?
- ANA D
- JZ DLGN ;yes, must be busy, do a normal redial
- ;
- ; Hang up, redial and listen for dial tone
- ;
- RNGBK1 CALL HANGUP ;hang up the phone
- CALL J$ILPRT
- DB 'ringback set, first ring ',0
- MVI B,RBWAIT ;wait 5 seconds before redialing
- CALL J$TIMER ; for line to clear, etc.
- CALL DIALBG ;disconnect, reconnect, wait for tone
- JC DLXIT
- LDA NUMBER ;number of characters in buffer
- CPI 1+1 ;more than one character?
- JNC DIAL14 ;if more than one, hand-entered number
- JMP DIAL12 ;go redial for the table ringback number
- ;
- RNGBK2 CALL J$ILPRT
- DB CR,LF,'++ No ringback for autodial modem ++',0
- POP H ;reset the stack
- JMP DLXIT
- ;
- HANGUP MVI A,CLEAR
- CALL O$MDCTL2
- XRA A
- JMP O$MDCTL1 ;turn off DTR, originate/answer tones
- ;
- ; This is the auto-linking area. Up to 32 numbers may be linked, each
- ; should have a comma for a separator, such as:
- ;
- ; B>>COMMAND: CAL A,F,3,A,G,A,H
- ;
- AUTO STA AUTDIR ;direct to terminal mode on answer
- ;
- AUTO1 MVI A,0FFH ;set the flags to -1
- STA AUTOFL ;set the auto-linking flag
- STA CRFLAG ;set the continuous redial flag
- MVI B,64 ;maximum number of characters to move
- LXI H,CMDBUF+1 ;start with number in the string
- LXI D,CMDBUF+65 ;move to aft part of buffer
- JMP MOVE ;when finished return to caller
- ;
- ; Linking routine
- ;
- AUTO2 LDA AUTOFL ;increment the flag for each new try
- INR A
- INR A
- STA AUTOFL
- MOV C,A ;hold momentarily
- MVI B,0
- LDA CMDBUF+65 ;see how many characters typed
- CMP C
- JNC AUTO3
- MVI A,1 ;reset the flag to start over
- MOV C,A
- STA AUTOFL
- ;
- AUTO3 LXI H,CMDBUF+65
- DAD B
- JMP DIAL6 ;go to work
- ;
- AUTDIR DB 0 ;direct to terminal mode on answer
- AUTOFL DB 0 ;auto-linking flag
- NUMBER DB 0 ;number of characters in CMDBUF
- ;
- ; Time-out routine. Must be called with mask in 'D' reg. for input at
- ; relative port 2 and number of seconds (times 10) in 'C' reg.
- ;
- WAIT MVI B,2
- CALL TIMER ;wait for timer to go high then low
- CALL I$BAUDRP ;PMMIADDR+2 (modem status port)
- ANA D ;(CTS or dialtone mask)
- RZ ;active low, so return on 0
- PUSH B ;save the registers
- PUSH D
- CALL STAT ;keypress?
- JZ WAIT1 ;if not, exit
- CALL KEYIN ;yes, get char
- CPI CANCEL ;CTL-X to intentionally abort?
- JZ WAIT2 ;yes, disconnect, jmp to menu
- ;
- WAIT1 POP D ;restore the registers
- POP B
- DCR C ;count-down
- JNZ WAIT
- STC ;set carry to indicate mask not set
- RET
- ;
- WAIT2 POP D ;restore the registers
- POP B
- JMP DONETD ;disconnect
- ;
- ;=======================================================================
- ; SPECIAL PMMI MENU
- ;
- SPMEN LDA PMMIMD
- ORA A
- RZ
- CALL J$NXTSCR
- CALL J$ILPRT
- DB ' Additional Subcommands for PMMI Modems'
- DB CR,LF,LF
- DB ' Modem control:',CR,LF
- DB ' A - Answer tone for send or receive',CR,LF
- DB ' O - Originate tone for send or receive',CR,LF,LF
- DB ' Parity option:',CR,LF
- DB ' 1 - Set and check for odd parity',CR,LF
- DB ' 0 - Set and check for even parity',CR,LF
- DB ' Both ends must be capable of these options'
- DB CR,LF
- DB ' which are available only in R and S modes.'
- DB CR,LF
- DB ' The parity checking will be part of the'
- DB CR,LF
- DB ' file transfer protocol.',CR,LF,LF
- DB ' Speed Options:',CR,LF
- DB ' After entering your primary and secondary '
- DB 'options,',CR,LF
- DB ' you can set the modem speed by placing a '
- DB ' "." after',CR,LF
- DB ' the options followed by the speed e.g., '
- DB '300, 600.',CR,LF,LF
- DB ' EXAMPLE: SBO.600 will set the modem for '
- DB '600 baud',CR,LF,0
- RET ;all done
- ;
- ;=======================================================================
- ;
- ; Timer routine. Waits 0.1 seconds for each unit in 'B' reg.
- ;
- TIMER PUSH H
- ;
- TIMER1 PUSH B
- ;
- TIMER2 CALL J$INMDM ;100 ms. delay per loop
- JNC TIMER2
- POP B
- DCR B
- JNZ TIMER1
- POP H
- RET
- ;
- ; CALCULATES DISK SPACE REMAINING IF CP/M+
- ;
- CKCPM3 CALL CRLF
- MVI C,CPMVER ;check version #
- CALL BDOS
- MOV A,L
- CPI 30H ;version 3.0?
- RC ;use normal method if not CP/M 3.0
- POP H ;remove 'CALL CKCPM3' from stack
- MVI C,CURDSK
- CALL BDOS
- MOV E,A
- MVI C,46 ;CP/M 3.0 compute free space call
- CALL BDOS
- MVI C,3 ;answer is 3 bytes long (24 bits)
- ;
- FREE30 LXI H,TBUF+2 ;answer is located here
- MVI B,3 ;convert to 'K' length
- ORA A
- ;
- FREE31 MOV A,M
- RAR
- MOV M,A
- DCX H
- DCR B
- JNZ FREE31 ;loop for 3 bytes
- DCR C
- JNZ FREE30 ;shift 3 times
- LHLD TBUF ;get result in 'K'
- JMP PRTFREE ;display result
- ;
- ;=======================================================================
- ;
- ORG (($+255+50)/256*256)-50 ;so 'NUMLIB' starts on even page
- ;
- ;-----------------------------------------------------------------------
- ;
- ; Long distance alternate dialing such as MCI, SPRINT, etc. Must end
- ; with a '$', use as many commas (2 seconds delay, each) as needed to
- ; let the alternate dialing code return with a new dial tone. Fill in
- ; any character (periods are fine) after the $ to keep number of columns
- ; to 24, i.e., '1234567,,,,12345,,$.....' -- the first group is the
- ; MCI or SPRINT access number, the second group is the user number. A
- ; small delay is usually required after the billing number also.
- ;
- ALTDL1 DB 'xxxxxxx,,,,,,xxxxxxxx,,$' ;accessed by a < character
- ;
- ALTDL2 DB 'xxxxxxx,,,,,,xxxxxxxx,,$' ;accessed by a > character
- ;
- ;=======================================================================
- ;
- HEXSHO DB SHOWHEX ;can easily change SHOWHEX via DDT
- ;
- SAVSIZ DB XFRSIZ*8 ;can easily change buffer size for file
- ;transfers with DDT for "NUMLIB-1" ad-
- ;dress. Normally 4k (32 records or 4k).
- ;
- ;=======================================================================
- ;
- ; Phone number library table for auto-dialing. Each number must be as
- ; long as"LIBLEN" (EQU at start of program). Some areas require extra
- ; characters such as: 1-313-846-7127. Room is left for those. Use
- ; a (<) for alternate dialing system #1, and a (>) for alternate dialing
- ; System #2. Either would preceed the actual number, for example:
- ;
- ; DB 'A=Alan Alda..........<123-456-7890' ;'A'
- ;
- ; - - - - - - - - - - - -
- ;
- ; NOTE: At least one dot (.) MUST precede the actual phone number
- ;
- ; '----5---10---15---20---25---30--34'
- NUMLIB DB 'A=Bob Robesky.......1-209-227-2083' ;'A'
- DB 'B=Byron McKay.......1-415-965-4097' ;'B'
- DB 'C=Chuck Metz........1-408-354-5934' ;'C'
- DB 'D=Bruce Jorgens.....1-509-255-6324' ;'D'
- DB 'E=Bill Earnest......1-215-398-3937' ;'E'
- DB 'F=Chuck Forsberg....1-503-621-3193' ;'F'
- DB 'G=Ron Fowler........1-414-563-9932' ;'G'
- DB 'H=Kirk De Haan......1-408-296-5078' ;'H'
- DB 'I=Jack Kinn.........1-817-547-8890' ;'I'
- DB 'J=Walt Jung.........1-301-661-2175' ;'J'
- DB 'K=Keith Petersen....1-313-759-6569' ;'K'
- DB 'L=Larry Snyder......1-305-671-2330' ;'L'
- DB 'M=Wayne Masters.....1-408-378-7474' ;'M'
- DB 'N=Dick Mead.........1-213-799-1632' ;'N'
- DB 'O=Al Mehr...........1-408-238-9621' ;'O'
- DB 'P=Pasadena RBBS.....1-213-577-9947' ;'P'
- DB 'Q=Mark Pulver.......1-312-789-0499' ;'Q'
- DB 'R=Bruce Ratoff......1-201-272-1874' ;'R'
- DB 'S=Ken Stritzel......1-201-584-9227' ;'S'
- DB 'T=TCBBS, Dearborn...1-313-846-6127' ;'T'
- DB 'U=AnaHUG RCPM.......1-714-774-7860' ;'U'
- DB 'V=Dave Austin.......1-707-257-6502' ;'V'
- DB 'W=Bill Wood.........1-619-256-3914' ;'W'
- DB 'X=Charlie Hoffman...1-813-831-7276' ;'X'
- DB 'Y=Byron Kantor......1-619-273-4354' ;'Y'
- DB 'Z=Spare.............1-xxx-xxx-xxxx' ;'Z'
- DB '0=Paul Bagdonovich..1-201-747-7301' ;'0'
- DB '1=Bill Parrott......1-913-682-3328' ;'1'
- DB '2=Alex Soya.........1-305-676-3573' ;'2'
- DB '3=Tony Stanley......1-912-929-8728' ;'3'
- DB '4=Tampa Bay Bandit..1-813-937-3608' ;'4'
- DB '5=Thousand Oaks.....1-805-492-5472' ;'5'
- DB '6=Spare.............1-xxx-xxx-xxxx' ;'6'
- DB '7=Spare.............1-xxx-xxx-xxxx' ;'7'
- DB '8=Spare.............1-xxx-xxx-xxxx' ;'8'
- DB '9=Spare.............1-xxx-xxx-xxxx' ;'9'
- DB 0 ;end
- ; '----5---10---15---20---25---30--34'
- ;
- ;-----------------------------------------------------------------------
- ;
- ; This is the storage area for the ten function keys. The M7FNK.COM
- ; program dynamically allocates the storage for the keys. Thus, no
- ; function key is limited to so-and-so many characters. Rather, the
- ; total number of bytes in the function key library (including flags)
- ; is 256.
- ;
- INTCPT DB '^' ;intercept character (prefix)
- ;
- FNCTBL DB 0,'DIR ',CR,0
- DB 1,'DIR *.* $U0AD ',CR,0
- DB 2,'XMODEM S ',0
- DB 3,'XMODEM R ',0
- DB 4,'BYE ',CR,0
- DB 5,'RBBS ',CR,0
- DB 6,'(vacant)',0
- DB 7,'(vacant)',0
- DB 8,'(vacant)',0
- DB 9,'Nice chatting, see you again soon... ',CR,0
- DS 256-($-FNCTBL)
- ;
- ;
- ;********************************************************************
- ; PROGRAM STARTS HERE
- ;********************************************************************
- ;
- START LXI H,0
- DAD SP ;add the current stack pointer to 'HL'
- SHLD STACK
- LXI SP,STACK ;start local stack
- ;
- ; The 'FIXCNT' calculations are done here and the values stored so the
- ; overhead of doing the calculation is not incurred in the RECV routine
- ; where it is desired to pick up a character from the modem data port as
- ; quickly as possible.
- ;
- LXI H,624 ;adjust to get 1 second time intervals
- CALL FIXCNT
- SHLD TIMVAL
- LXI H,39 ;should be 1/16 of above value
- CALL FIXCNT
- SHLD QUIKTIM
- ;
- ; Now display the program name and version number and we are under way
- ;
- CALL ILPRT
- DB CR,LF,'MODM',VERSION/100+'0',VERSION MOD 100/10+'0'
- DB VERSION MOD 10+'0',' (type M for Menu)',CR,LF,0
- CALL J$SYSVR ;give configuration message
- CALL CRCGN ;generate tables for fast 'CRC' check
- CALL INITAD ;initialize addresses
- CALL INTRCPT ;establish the function key intercept
- CALL PROCOPT ;process any options
- LDA OPTION ;any options on the command line?
- CPI ' '+1
- JC MENU ;if not, show the menu
- ;
- ; Comes here from menu once the options have been set
- ;
- RSTRT LXI SP,STACK ;make sure we have a clean stack
- CALL CKCHAR ;catch any garbage characters left over
- LDA PMMIMD
- ORA A
- JNZ RSTRT1 ;if yes, accept 'C' or 'D'
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ RSTRT2 ;exit if neither modem-type
- ;
- RSTRT1 LDA OPTION ;get the option
- CPI 'C' ;call (dial) function?
- JZ J$DIAL ;yes, go to it
- LDA PMMIMD
- ORA A
- CNZ STBAUD ;just the PMMI has to check each time
- ;
- RSTRT2 CALL MOVEFCB
- LDA OPTION ;get main option
- CPI 'D' ;disconnect?
- JZ DONETD ;yes, disconnect then back to the menu
- CPI 'M' ;menu asked for?
- JZ MENU2 ;go display the menu
- CPI 'R' ;want to receive a file?
- JZ RCVFL ;exit if yes
- CPI 'S' ;want to send a file?
- JZ SNDFL ;exit if yes
- CPI 'T' ;want terminal mode?
- JNZ RSTRT3 ;if not, exit
- XRA A
- STA ECHOFLG ;reset echo flag
- STA LOCFLG ;reset local flag
- JMP DSKSV ;exit if yes
- ;
- RSTRT3 CPI 'E' ;want echo mode?
- JNZ NOECHO ;if not, exit
- STA ECHOFLG ;set the echo flag
- XRA A
- STA LOCFLG ;reset local flag
- JMP DSKSV
- ;
- NOECHO CPI 'L' ;want local echo mode?
- JNZ NOLOCL ;if not, exit
- STA LOCFLG ;set the local flag
- XRA A
- STA ECHOFLG ;reset echo flag
- JMP DSKSV
- ;
- NOLOCL CALL NVLDMS ;say not a valid option
- JMP MENU ;then go back to the command mode
- ;
- INITAD LHLD 0000H+1 ;BIOS warm reboot jump vector
- LXI D,3
- DAD D
- SHLD VSTAT+1 ;BIOS console status jump vector
- DAD D
- SHLD VKEYIN+1 ;BIOS console keyboard jump vector
- DAD D
- SHLD VTYPE+1 ;BIOS console CRT jump vector
- LXI D,33
- DAD D
- SHLD GOLIST+1 ;BIOS list device status jump vector
- CALL GETUSER ;get current user number
- STA OLDUSER ;save to restore upon exit
- CALL GTMAX ;find maximum ram for printer use
- JMP J$INITMD ;initialize non-PMMI systems if needed
- ;
- ; Get the function key intercept character and put in appropriate places
- ;
- INTRCPT LDA INTCPT ;get the function key intercept char.
- ANI 07FH ;strip off any parity
- STA GTCMD1+1 ;store in the menu area
- CPI ' ' ;printing character?
- JNC INTER2 ;if yes, exit
- ADI 40H ;change to printing character
- JMP FIXFNK ;fix-patch area of extra bytes
- ;
- INTER1 MVI A,'^'
- STA MENU3 ;store the "control-" character
- RET
- ;
- INTER2 STA MENU3+1
- RET
- ;
- ; Process any options - put 0 in appropriate place in option table if
- ; option is selected
- ;
- PROCOPT LXI D,FCB+1
- LDAX D
- STA OPTION
- CPI ' ' ;exit if no options
- RZ
- ;
- OPTLP INX D
- LDAX D
- CPI ' '
- JZ ENDOPT
- LXI H,OPTBL
- MVI B,OPTBE-OPTBL
- ;
- OPTCK CMP M
- JNZ OPTNO
- CPI 'O' ;want originate tones?
- MOV B,A ;store momentarily
- MVI A,ORIGMOD
- JZ OPTCK1
- MOV A,B ;get the option back
- CPI 'A' ;want answer tones?
- JNZ OPTCK2 ;if not, exit
- MVI A,ANSWMOD
- ;
- OPTCK1 STA UARTCT
- ;
- OPTCK2 MVI M,0
- JMP OPTLP
- ;
- OPTNO INX H
- DCR B
- JNZ OPTCK
- CALL NVLDMS
- POP H ;preserve stack
- JMP MENU
- ;
- ENDOPT LDA VSEEFLG
- ORA A
- JNZ CKOPT
- STA QFLG ;quiet mode for watching data items
- ;
- CKOPT LDA OPTION ;check on the primary option
- CPI 'D' ;going to disconnect?
- RZ
- CPI 'E' ;return if echo option
- RZ
- CPI 'M' ;return if help option
- RZ
- CPI 'L' ;return if local echo option
- RZ
- CPI 'T' ;return if terminal mode
- RZ
- MOV B,A ;save the primary option for a moment
- LDA PMMIMD ;PMMI modem?
- ORA A
- JNZ CKOPT0 ;if yes, accept 'C'
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ CKOPT1 ;exit if neither
- ;
- CKOPT0 MOV A,B ;get the character back
- CPI 'C' ;going to call a number now?
- RZ
- ;
- CKOPT1 LDA NFILFLG ;saving memory for disk file?
- ORA A
- JZ CKOPT2 ;if not, continue
- POP H ;reset the stack from 'CALL PROCOPT'
- JMP MENU0 ;go show the 'FILE OPEN' message
- ;
- CKOPT2 MOV A,B ;get the option back
- CPI 'S'
- JZ CKFILE
- CPI 'R'
- JNZ BDOPT ;none of these, bad option
- LDA BCHFLG ;see if the batch mode flag is set
- ORA A
- RZ ;if yes, exit
- ;
- CKFILE LDA FCB+17 ;'S' and 'R' need a file name
- CPI ' '
- RNZ ;exit if a file name is present
- ;
- REENT CALL ILPRT
- DB '++ Enter primary option plus file name ++'
- DB CR,LF,BELL,0
- POP H ;reset stack from 'CALL STFCB
- JMP MENU ;abort to command line
- ;
- BDOPT CALL ILPRT
- DB CR,LF,'++ Bad option ++',CR,LF,LF,0
- ;
- ; Check for any garbage characters on line - catch and ignore
- ;
- CKCHAR CALL RCVRDY ;any characters ready to receive?
- RNZ ;if not, return
- CALL I$MDDATP ;otherwise get the character and ignore
- JMP CKCHAR ;check for any additional characters
- ;
- ; Revised terminal routine allowing memory save. First checks for bad
- ; options, to prevent wiping out the disk with accidental memory save.
- ;
- DSKSV LDA BCHFLG ;batch flag set?
- ORA A
- JNZ DSKSV1 ;if not set, everything is normal
- MVI A,'B' ;if set, shouldn't be, so reset it
- STA BCHFLG
- JMP NOTVLD ;if set, error for 'E', 'L' or 'T'
- ;
- DSKSV1 STA XFLG ;will use the ASCII capture buffer size
- LDA NFILFLG ;already saving for a file?
- ORA A
- JZ DSKSV2 ;exit if not, and open a file
- CALL BUFMS ;tell if buffer if on or off
- JMP TERM
- ;
- DSKSV2 LDA FCB+1 ;first character of filename (if any)
- CPI ' ' ;file specified?
- JNZ GOODNM ;yes, good name
- XRA A
- STA NFILFLG ;show no file being saved
- STA SAVEFLG ;reset the flag to zero
- JMP TERM
- ;
- GOODNM CALL ERASF
- LXI H,FCB3
- CALL INITFCB
- LXI H,FCB ;move the disk name into FCB3 area
- LXI D,FCB3
- MVI B,12
- CALL MOVE
- LXI D,FCB3 ;now make a file from that name
- MVI C,MAKE
- CALL BDOS
- LXI D,FCB3 ;now open the file from FCB3
- MVI C,OPEN
- CALL BDOS
- LXI H,BUFFER ;reset pointers to start of buffer
- SHLD HLSAV
- MVI A,1
- STA NFILFLG ;show now saving to memory for disk file
- CALL BUFMS2 ;show buffer is available
- ;
- TERM LDA LSTTST ;allowing the printer to be used?
- ORA A
- CNZ GOLIST ;if yes, see if anything to print
- CALL STAT ;keyboard have a character?
- JZ TERML ;if not, see if any incoming
- CALL KEYIN ;get character from keyboard
- MOV B,A ;save for now to protect 'A' reg.
- CPI RUB ;test for rub
- JNZ NOTRUB ;exit if not
- LDA CONVRUB ;convert rub to backspace?
- ORA A
- JZ NOTRUB ;exit if no conversion
- MVI B,BKSP ;call it a backspace
- JMP NTOG ;go send a backspace
- ;
- NOTRUB LDA FNKFLG ;get function key active flag
- ORA A
- JZ NOF ;if not set yet, exit
- MOV A,B ;get character
- CPI '0'
- JC NOFNK1 ;ignore invalid key codes
- CPI '9'+1
- JNC NOFNK1
- ANI 0FH ;make 0..9
- JMP SNDFK
- ;
- NOF LDA INTCPT ;check intercept character
- CMP B
- JNZ NOFNK1 ;skip if no function key
- STA FNKFLG ;set the function flag
- JMP TERML ;do not send the intercept character
- ;
- NOFNK1 XRA A ;reset the flag
- STA FNKFLG
- LDA EXACFLG
- ORA A ;exact?
- MVI A,0 ;(cannot use 'XRA A' here)
- STA EXACFLG ;clear for next time
- JZ NTEXAF ;go if EXACFLG not set 'YES'
- LDA LOCNXT
- ORA A ;should we send on exacflg?
- JZ NTOG ;jump if LOCONEXTCHR 'NO'
- LDA EXTCHR ;we want to send EXTCHR in any case
- CMP B
- JZ NTOG ;send if EXTCHR
- JMP LOCCHK ;otherwise do local stuff
- ;
- NTEXAF LDA EXTCHR ;treat next character in special way?
- CMP B ;check against this control character
- JNZ NTEXA1 ;yes, set exacflg for next character
- MVI A,1
- STA EXACFLG ;set the flag
- JMP TERM ;do not send, get next character
- ;
- NTEXA1 LDA LOCNXT
- ORA A ;should we send if not EXACFLG?
- JNZ NTOG ;jump if loconextchr 'YES'
- ;
- LOCCHK CALL XITST1 ;want to exit to menu?
- LDA NOCONCT ;want to disconnect from line?
- CMP B
- JZ DONETD ;if yes go disconnect
- LDA TRANCHR ;output text file to remote?
- CMP B
- JZ TRNSFR
- LDA TRANLOG
- ORA A
- JZ SKPLOG
- LDA LOGCHR ;send logon?
- CMP B
- JZ SNDLOG
- ;
- SKPLOG LDA LSTTST ;going to use the external printer?
- ORA A
- JZ NOLST ;if not, skip this area
- LDA LSTCHR ;get the printer control-character
- CMP B ;did we just ask for printer control?
- JNZ NOLST ;if not, exit
- LDA LISTFLG ;otherwise reset the printer toggle
- CMA
- STA LISTFLG ;and store
- CALL CRLF
- CALL CRLF
- CALL LSTMS ;tell if printer is on or off now
- CALL CRLF
- JMP TERML ;back to the terminal mode again
- ;
- NOLST LDA BRKCHR ;PMMI break?
- CMP B
- JZ BREAK
- LDA PMMIMD ;using a PMMI board?
- ORA A
- JZ NOLST1 ;if not, skip the next few lines
- LDA CHGBAUD ;PMMI change baud?
- CMP B
- PUSH PSW
- PUSH H
- CZ J$NWBAU
- POP H
- POP PSW
- JZ TERML
- ;
- NOLST1 LDA UNSAVCH ;close input buffer?
- CMP B
- JZ NOLST2 ;if yes, disable copy
- LDA SAVECHR ;open input buffer?
- CMP B
- JNZ NTOG
- LDA NFILFLG ;do not allow save if flag is set
- ORA A
- JZ TERML
- JMP NOLST3
- ;
- NOLST2 XRA A ;stop copy into file
- ;
- NOLST3 STA SAVEFLG
- CALL BUFMS
- JMP TERM ;get next character
- ;
- ;***********************************************************************
- ; SEND A CP/M FILE
- ;***********************************************************************
- ;
- SNDFL XRA A ;set to checksum initially on send
- STA CRCFLAG ; initially on send
- CALL CKCHAR ;catch any garbage characters
- ;
- SNDFL1 LDA BCHFLG ;check if multiple file
- ORA A ; mode is set.
- JNZ SNDC1
- CALL ILPRT
- DB 'Ready to send in batch mode',CR,LF,0
- ;
- SNDFL2 CALL J$PRITY
- MVI A,YES ;indicate send for batch mode
- STA SNDFLG
- LDA FSTFLG ;if first time through
- ORA A ; scan the command line
- CZ TNMBUF ; for multiple names
- CALL SNDFN ;sends file name to receive
- PUSH PSW
- CALL CRLF
- CALL SHOFIL
- MVI A,' '
- CALL TYPE
- POP PSW
- JNC SNDC2 ;carry set means no more files
- MVI A,'B' ;stop batch
- STA BCHFLG ;mode option
- MVI A,EOT ;final transfer end
- CALL SND
- JMP DONE
- ;
- SNDC1 LDA FCB+1
- CPI ' '
- JZ BLKFILE
- ;
- SNDC2 CALL CNREC ;get number of records
- CALL OPENFIL
- MVI E,120 ;wait 2 minutes maximum
- CALL WAITNAK
- ;
- SNDLP CALL CKABORT ;want to terminate while sending file?
- CALL RDRECD
- JC SNDEOF
- CALL INCRRNO
- MVI A,1
- STA ERRCT
- ;
- SNDRPT CALL CKABORT ;want to terminate while sending file?
- CALL SNDHDR
- CALL SNDREC
- LDA CRCFLAG
- ORA A
- CZ SNDCKS
- CNZ SNDCRC
- CALL GTACK
- JC SNDRPT
- JMP SNDLP
- ;
- SNDEOF MVI A,EOT
- CALL SND
- CALL GTACK
- JC SNDEOF
- JMP DONE
- ;
- ;***********************************************************************
- ; RECEIVE A CP/M FILE
- ;***********************************************************************
- ;
- RCVFL LDA CRCDFLT ;get mode requested by operator
- STA CRCFLAG ;store it
- ;
- RCVFL1 CALL J$PRITY
- LDA BCHFLG ;check if multiple file mode
- ORA A
- JNZ RCVC1 ;if not, exit
- MVI A,NO ;flag where to return
- STA SNDFLG ; for next file transfer
- CALL GETFN ;get the file name
- JNC RCVC2 ;carry set means no more files
- MVI A,'B' ;stop batch
- STA BCHFLG ;mode option
- JMP DONE
- ;
- RCVC1 LDA FCB+1 ;make sure file is named
- CPI ' '
- JZ BLKFILE
- JMP RCVC3
- ;
- RCVC2 CALL SHOFIL ;show the file name
- MVI A,' '
- CALL TYPE
- CALL SNDPRG ;get progress and wait for quiet line
- CALL CKCPM2
- CALL CRLF
- CALL CKBAKUP
- ;
- RCVC3 CALL ERASF
- CALL MAKEFIL
- CALL WAITQ1
- LDA BCHFLG ;do not print message if in batch mode
- ORA A
- JZ RCVFST
- CALL ILPRTQ
- DB 'File open, ready to receive',CR,LF,0
- ;
- RCVFST LDA CRCFLAG
- ORA A
- JZ RCVNKM ;if in 'CRC' mode
- CALL ILPRTQ ;then say so
- DB 'CRC in effect',CR,LF,0
- MVI A,CRC
- JMP RCVLP0
- ;
- RCVNKM CALL ILPRTQ ;else say 'CHECKSUM' mode
- DB 'Checksum in effect',CR,LF,0
- MVI A,NAK
- ;
- RCVLP0 PUSH PSW
- CALL ILPRT
- DB 'Waiting.....',0
- ;
- NOPRG POP PSW
- CALL SND
- ;
- RCVLP CALL RCVRECD
- JC RCVEOT
- CALL REPORT ;show record received if not in quiet
- CALL WRRECD
- CALL INCRRNO
- CALL SNDACK
- JMP RCVLP
- ;
- RCVEOT CALL WRBLOCK
- CALL SNDACK
- CALL CLOSFIL
- JMP DONE
- ;
- SNDACK MVI A,ACK
- CALL SND
- RET
- ;
- ;=================== FILE TRANSFER IN T-MODE ===========================
- ;
- ; File transfer routine - called with CTL-T from terminal mode. Trans-
- ; fer may be cancelled while sending, by using CTL-X.
- ;
- TRNSFR LXI H,FCB4
- CALL INITFCB ;initializes FCBs pointed
- LXI H,FCB+16 ; to by 'HL' register
- CALL INITFCB
- ;
- ; Get name of file to send in "T" (terminal) mode
- ;
- GET CALL ILPRT
- DB CR,LF,'File name to send? (CR to abort): ',0
- LXI D,CMDBUF
- CALL INBUF
- LDA CMDBUF+2 ;was file entered?
- CPI ' '
- JZ RETRN ;if not probably wanted to quit
- LXI D,CMDBUF
- LXI H,FCB4
- CALL CMDLINE
- LXI D,FCB4
- MVI C,OPEN
- CALL BDOS
- CPI 0FFH ;return with 0FFH means 'NO SUCH FILE'
- JZ TRANSL
- LDA XONWAIT ;waiting for X-on to send next line?
- ORA A
- JNZ DLYSAV ;if yes, skip additional delays
- ;
- ; Choice of normal speed or delays between characters / lines
- ;
- CALL ILPRT
- DB 'Want to include time delays? (Y/N): ',0
- CALL KBDCHR
- CPI 'N' ;if 'N' send normal speed
- JZ DLYSAV
- XRA A ;otherwise use character/line delays
- ;
- DLYSAV STA DLYFLG ;store the decision
- CALL CRLF
- LXI D,CMDBUF+2 ;make sure cmdbuf has been selected
- MVI C,STDMA
- CALL BDOS
- ;
- ; Get 128-byte record
- ;
- READM LXI D,FCB4
- MVI C,READ
- CALL BDOS
- ORA A ;check for a good read
- JZ READM1
- DCR A ;check for end of file to send
- JZ RETRNS
- CALL ERXIT ;neither of those, was a read error
- DB '++ DISK READ ERROR ++','$'
- ;
- ; Successful read, so send the record
- ;
- READM1 CALL SND80C ;send one 128-char record
- CPI EOFCHAR ;end of file - omit if object
- JZ RETRNS ; code is to be sent.
- CPI CANCEL ;cancellation?
- JNZ READM
- ;
- RETRN CALL ILPRT
- DB CR,LF,LF,'(in Terminal-mode now)',CR,LF,LF,0
- CALL SNDNOW ;insures last character is finished
- CALL CKCHAR ;catch any echo character on line
- JMP TERM ;finished, back to t-mode
- ;
- RETRNS CALL ILPRT
- DB CR,LF,'[Transfer completed]',0
- JMP RETRN
- ;
- TRANSL CALL ILPRT
- DB CR,LF,BELL,'++ FILE NAME ERROR ++ ',CR,LF,0
- JMP GET
- ;
- ; Send one 128-byes record
- ;
- SND80C MVI B,128 ;will send a maximum of 128 character
- LXI H,CMDBUF+2 ;they are in the cmdbuf area
- ;
- SNDCH1 PUSH D
- CALL SPEED ;0-90 ms. delay between characters
- POP D
- MOV A,M
- CPI EOFCHAR
- RZ
- CALL MDOUT ;send the character to modem
- CALL STAT ;test to see if
- ORA A ;cancellation requested
- JZ SKIP1
- CALL KEYIN
- CPI CANCEL
- RZ
- ;
- SKIP1 INX H
- DCR B
- JNZ SNDCH1
- RET
- ;
- ; Send the character to the output
- ;
- MDOUT PUSH PSW ;save the character so can use 'A' reg.
- CPI LF
- JNZ MDOUTL
- LDA ADDLFD ;going to send the line feed to modem?
- ORA A
- JNZ MDOUTL ;if yes, exit
- POP PSW ;get the char. back (a line feed)
- CALL TYPE ;show on CRT, do not send to modem
- RET
- ;
- MDOUTL LDA XOFFTST ;waiting for X-off, X-on ?
- ORA A
- CNZ TXOFF ;if yes, go check
- CALL SNDRDY ;wait until modem is ready to send
- JNZ MDOUTL
- POP PSW ;get the character back
- CALL TYPE ;send character to CRT
- CALL O$MDDATP ;send character to modem
- CPI CR ;was it an end of line?
- RNZ ;if yes, see if any delay is needed
- ;
- ; Delay to allow slow BBS systems (most use BASIC) to enter the line.
- ; Choice of 0-9 for about 100 ms. each, maximum of 900 ms.
- ;
- MDOUTN LDA XONWAIT ;wait for X-on after CR?
- ORA A
- JNZ WATXON ;if yes, handle separately
- MVI D,10
- ;
- MDOUTT PUSH D
- CALL SPEED1 ;10 ms delay
- POP D
- DCR D
- JNZ MDOUTT ;10 loops for 100 ms.
- RET
- ;
- ; Add from 0 to 90 ms. delay between characters for slow (most use
- ; BASIC) bulletin board systems. Also used to add 0-900 ms. delay
- ; between lines.
- ;
- SPEED LDA BYTDLY ;get delay between characters (0-9)
- JMP SPEED1+3 ;1=10 ms, 5=50 ms, 9=90 ms, etc.
- ;
- SPEED1 LDA CRDLY ;get delay after crlf (0-9)
- ORA A ;100 ms, 5=500 ms, 9=900 ms, etc.
- RZ ;if no delay needed, return
- MOV C,A ;store number requested in c-reg.
- LDA DLYFLG ;want any delays this file?
- ORA A
- RNZ ;if not, skip this section
- ;
- SPEED2 CALL SPEED3 ;outer loop
- DCR C
- JNZ SPEED2
- RET ;done whenever the c-reg. is zero
- ;
- SPEED3 PUSH H ;save current 'HL' value
- LXI H,20
- LDA XOFFTST
- ORA A
- JZ SPEED4
- LXI H,20 ;adjust for 'X-OFF' testing
- LDA ECHOFLG
- ORA A
- JZ SPEED4
- LDA LOCFLG
- ORA A
- JZ SPEED4
- LXI H,25 ;adjust for remote echo
- ;
- SPEED4 CALL FIXCNT ;multiply delay by clock speed
- XCHG ;transfer delay to 'DE'
- POP H ;restore current 'HL' from"speed3"
- ;
- SPEED5 DCX D ;inner loop
- LDA XOFFTST
- ORA A
- CNZ TXOFF
- MOV A,E
- ORA D
- JNZ SPEED5
- RET
- ;
- TXOFF CALL RCVRDY
- RNZ
- CALL I$MDDATP
- ANI 7FH
- CPI XOFF
- CZ WATXON
- RET
- ;
- WATXON CALL RCVRDY ;have a character? (like x-on)
- JNZ WATXN1 ;if no character see if want to abort
- CALL I$MDDATP
- ANI 7FH ;strip off any parity
- CPI XON ;see if character was X-on
- RZ ;if yes, keep going
- ;
- WATXN1 CALL STAT ;test to see if requesting cancellation
- JZ WATXON
- CALL KEYIN ;can abort if the x-on never comes
- CPI CANCEL ;CTL-X to abort?
- JNZ WATXON ;if not, keep going
- RZ
- ;
- ;***********************************************************************
- ; SUBROUTINES
- ;***********************************************************************
- ;
- ; Returns with the zero flag set if retry requested. If using multi-
- ; file (batch) mode, then no questions asked, just quit.
- ;
- CKQIT LDA BCHFLG ;using batch mode now?
- ORA A
- JZ ABORT ;quit if using batch mode
- ;
- CKQIT1 MVI A,1
- STA ERRCT
- CALL ILPRT
- DB CR,LF,'Multiple errors encountered.',CR,LF
- DB 'Type Q to quit, R to retry: ',BELL,0
- CALL KEYIN
- PUSH PSW
- CALL CRLF
- POP PSW
- CALL UCASE ;instead of 'ANI 5FH'
- CPI 'R'
- JZ RCVRECD ;if 'R' keep trying
- CPI 'Q'
- JNZ CKQIT1
- JMP ABORT
- ;
- ; Show the file name as stored in the FCB but in CP/M format
- ;
- SHOFIL LDA QFLG ;can type it if no 'QFLG'
- ORA A
- RZ
- LXI H,FCB+1
- ;
- SHONM XRA A
- STA FTYCNT
- MVI C,11
- ;
- PRNAM CALL FTYTST
- INX H
- DCR C
- JNZ PRNAM
- RET
- ;
- ; Give report of received records as they occur
- ;
- REPORT LDA QFLG
- ORA A
- RZ
- LHLD RECNO ;get record number
- INX H
- CALL ILPRT
- DB CR,'Received # ',0
- CALL DECOUT ;print record number in decimal
- CALL ILPRT
- DB ' ',0
- ;
- LDA HEXSHO
- ORA A
- RZ
- CALL ILPRT
- DB '(', 0
- CALL DHXOUT ;16 bit hex conversion and output
- CALL ILPRT
- DB 'H) ',0
- 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 TYPE ;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 TYPE
- JMP ENDSPT ;output 1st file type byte
- ;
- ; Get sender's progress report if it is present and wait for line to get
- ; quiet
- ;
- SNDPRG MVI B,5 ;wait up to 5 seconds
- CALL RECV
- CALL TYPE ;show the progress report from sender
- JNC SNDPRG
- RET
- ;
- SNDFN CALL ILPRTQ
- DB 'Awaiting name NAK ',CR,LF,0
- CALL GTACK
- CC SNDACK
- LXI H,FILECT
- DCR M
- JM NOMRN
- LHLD NBSAVE ;get file name in FCB
- LXI D,FCB
- MVI B,12
- CALL MOVE
- SHLD NBSAVE
- CALL SNDNM ;send it
- ORA A ;clear carry
- RET
- ;
- NOMRN MVI A,EOT
- CALL SND
- STC
- RET
- ;
- ; Wait for line to get quiet and gobble characters
- ;
- WAITQ1 MVI B,1
- CALL RECV
- JNC WAITQ1
- RET
- ;
- SNDNM PUSH H
- ;
- SNDNM1 MVI D,11 ;count characters in name
- MVI C,0 ;initialize checksum
- LXI H,FCB+1 ;address name
- ;
- NAMLPS MOV A,M ;send name
- ANI 7FH ;strip high order bit so CP/M 2.x
- CALL SND ; will not send R/O file designation
- ;
- ACKLP PUSH B ;save checksum
- MVI B,5 ;wait for receiver to acknowledge
- CALL RECV ; getting the letter
- POP B
- JC SCKSER
- CPI ACK
- JNZ ACKLP
- INX H ;next character
- DCR D
- JNZ NAMLPS
- MVI A,EOFCHAR ;tell receiver the end of name
- CALL SND
- MOV D,C ;save checksum
- ;
- CKSMLP MVI B,5 ;wait up to 5 seconds
- CALL RECV ;get checksum
- CMP D
- JNZ SCKSER ;exit if bad name
- MVI A,OKNMCH ;good name-tell receiver
- CALL SND
- POP H
- RET
- ;
- SCKSER MVI A,BDNMCH ;bad name-tell receiver
- CALL SND
- CALL ILPRT
- DB CR,LF,'++ ERROR sending name ++',CR,LF,0
- MVI E,120 ;do handshaking over (2 minutes maximum)
- CALL WAITNLP ;don't print "WAITING READY SIGNAL" msg.
- CALL SNDACK
- JMP SNDNM1
- ;
- ; This patch fixes a problem with the display of the function key
- ; group on the menu. It uses some of the extra bytes available in
- ; this area from the CKSMLP fix.
- ;
- FIXFNK STA MENU3+1 ;store the character in the menu display
- CPI '[' ;'ESC' character, printed
- JNC INTER2 ;if 'ESC' or more, exit
- JMP INTER1 ;otherwise include a '^'
- ;
- ; Patch to close FCB3 instead of FCB when in disk-capture mode.
- ;
- WRERRSP CALL WRFIL2 ;close FCB3 file
- JMP WRERR1 ;go write 'DISK FULL' message and quit
- ;
- EXTRA DB '123456789 ' ;10 extras from CKSMLP (there were 27)
- ;
- GETFN LXI H,FCB
- CALL INITFCB+2 ;does not initialize drive
- CALL ILPRTQ
- DB 'Awaiting file name',CR,LF,0
- CALL HSNAK
- CALL GETNM ;get the name
- CPI EOT ;if EOT, then no more files
- JZ NOMRNG
- ORA A ;clear carry
- RET
- ;
- NOMRNG STC
- RET
- ;
- GETNM PUSH H
- ;
- GETNM1 MVI A,0FFH
- STA FLTRFLG
- MVI C,0 ;initialize checksum
- LXI H,FCB+1
- ;
- NAMELPG MVI B,5
- CALL RECV ;get the character
- PUSH B
- PUSH PSW
- MVI A,0FFH
- STA TIMFLG
- MVI B,1
- CALL RECV
- XRA A
- STA TIMFLG
- POP PSW
- POP B
- JNC GETNM3
- CALL ILPRTQ
- DB 'Time out receiving filename',CR,LF,0
- JMP GCKSER
- ;
- GETNM3 CPI EOT ;if EOT, then no more files
- JZ GNRET
- CPI EOFCHAR ;got end of name
- JZ ENDNAM
- PUSH PSW
- PUSH B
- CALL SNDACK
- POP B
- POP PSW
- MOV M,A ;put name in FCB
- INX H ;get next character
- MOV A,L ;do not let noise cause overflow
- CPI 7FH ; into the program area
- JZ GCKSER
- JMP NAMELPG
- ;
- ENDNAM XRA A
- STA FLTRFLG
- MOV A,C ;send checksum
- MOV D,C
- CALL SND
- ;
- NMLP1 MVI B,5 ;wait up to 5 seconds to see if
- CALL RECV ; the checksum is good
- CPI OKNMCH ;yes if 'OKNMCH' sent
- JZ GNRET
- CMP D
- JZ NMLP1 ;in case it is echo of send
- CPI CR
- JZ NMLP1
- CPI LF
- JZ NMLP1
- ;
- GCKSER LXI H,FCB ;clear FCB (except drive) since it
- CALL INITFCB+2 ; might be damaged
- CALL ILPRTQ
- DB CR,LF,'** Checksum error **',CR,LF,0
- XRA A
- STA FLTRFLG
- CALL HSNAK ;do handshaking over
- JMP GETNM1
- ;
- GNRET PUSH PSW
- XRA A
- STA FLTRFLG
- POP PSW
- POP H
- RET
- ;
- HSNAK MVI E,180 ;3 minute wait for file name
- XRA A
- STA FLTRFLG
- ;
- HSNAK1 CALL CKABORT ;want to abort?
- MVI A,NAK ;send 'NAK' until receiving 'ACK'
- CALL SND
- MVI B,1 ;wait up to 1 second for a character
- CALL RECV
- CPI ACK ;'ACK' is what we were waiting for
- RZ
- DCR E
- JNZ HSNAK1
- JMP ABORT ;back to command line
- ;
- TNMBUF MVI A,1 ;call from 'SNDFL' only once
- STA FSTFLG
- XRA A
- STA FILECT
- CALL SCAN
- LXI H,NAMEBUF
- SHLD NBSAVE ;save address of 1st name
- ;
- TNLP1 CALL TRTOBUF
- LXI H,FCB
- LXI D,FCBBUF
- CALL CMDLINE ;parse name to CP/M format
- ;
- TNLP2 CALL MFNAM ;search for names (wildcard format)
- JC NEXTNM
- LDA FCB+10 ;if CP/M 2.x SYS file
- ANI 80H ; do not send
- JNZ TNLP2
- LHLD NBSAVE ;get name
- LXI D,FCB ;move it to FCB
- XCHG
- MVI B,12
- CALL MOVE
- XCHG
- SHLD NBSAVE ;address of next name
- LXI H,FILECT ;count files found
- INR M
- JMP TNLP2
- ;
- NEXTNM LXI H,NAMECT ;count names found
- DCR M
- JNZ TNLP1
- LXI H,NAMEBUF ;save start of buffer
- SHLD NBSAVE
- LDA FILECT
- CPI 64+1 ;no more than 64 transfers
- RC
- MVI A,64 ;only transfer first 64
- STA FILECT
- RET
- ;
- ; Tells when buffer is opened/closed for memory save to write on disk
- ;
- BUFMS CALL ILPRT
- DB CR,LF,'** Memory buffer ',0
- LDA SAVEFLG
- ORA A
- JZ BUFMS1
- CALL ILPRT
- DB 'open **',CR,LF,LF,';',0
- RET
- ;
- BUFMS1 CALL ILPRT
- DB 'closed **',CR,LF,LF,0
- RET
- ;
- BUFMS2 CALL ILPRT
- DB CR,LF,'** Memory buffer available **',CR,LF,0
- RET
- ;
- ; Clear the screen and return to the menu command
- ;
- XITMNU CALL CRLF
- CALL CLREOS ;clear line to clean up any mess
- JMP MENU0
- ;
- ; Checks to see if the modem has a character ready
- ;
- RCVRDY CALL I$MDCTL1
- CALL A$MDRCVB
- JMP C$MDRCVR
- ;
- ; Checks to see if the modem is ready to receive a character
- ;
- SNDRDY CALL I$MDCTL1
- CALL A$MDSNDB
- JMP C$MDSNDR
- ;
- SNDNOW CALL XITST ;see if want to quit now
- CALL SNDRDY ;ready to send a character?
- JNZ SNDNOW ;if not ready wait some more
- RET ;exit if ready
- ;
- ; Send the log-on message when requested
- ;
- SNDLOG LHLD LOGONPTR ;'HL' points to start of logon message
- CALL LOGLP
- JMP TERML
- ;
- LOGLP CALL SNDNOW ;wait until modem is ready
- MOV A,M ;get logon byte
- ORA A ;last character in string is '0'
- RZ ;return if finished
- CALL O$MDDATP ;otherwise send the character
- CALL LOGLP1 ;check for echo character and display it
- INX H ;next location in message
- JMP LOGLP ;get next character
- ;
- LOGLP1 CALL J$INMDM ;get the echo character
- CC J$INMDM ;if none, try once more
- RC ;if no character do not try to print
- ANI 7FH ;strip off any parity
- JMP TYPE ;display the character, then return
- ;
- ; Check for exit character
- ;
- XITST CALL STAT ;anything on keyboard?
- RZ
- CALL KEYIN ;get it, then
- MOV B,A ;save to protect the 'A' register
- ;
- XITST1 MVI A,EXITCHR ;exit character
- CMP B ;asking to exit to menu?
- RNZ ;if not, back to work
- POP H ;clear the stack from 'CALL'
- JMP XITMNU ;exit to the menu
- ;
- LSTMS CALL ILPRT
- DB 'Printer buffer is ',0
- LDA LISTFLG ;see if printer should be on or off
- ORA A
- JZ LSTMS1
- CALL ILPRT
- DB 'ON',CR,LF,0
- RET
- ;
- LSTMS1 CALL ILPRT
- DB 'OFF',CR,LF,0
- RET
- ;
- ; Special function key handler. This routine is entered with the
- ; function key number (0..9) in A. The corresponding function key is
- ; then transmitted.
- ;
- SNDFK PUSH H ;save register
- LXI H,FNCTBL ;point to function key codes
- ;
- SFK1 CMP M ;this the one?
- INX H ;point to next byte
- JNZ SFK1 ;loop until found
- CALL LOGLP ;send the char
- POP H
- XRA A ;reset the function flag
- STA FNKFLG
- JMP TERML
- ;
- ; Send keyboard character to modem, also to console if "E" or "L". If
- ; "E" include a LF after a CR, if either, include a LF if toggle is set.
- ;
- NTOG CALL SNDCHR ;send char. in 'B' to modem
- LDA LOCFLG ;using the local mode?
- ORA A
- JNZ LTYPE ;if yes, show the character
- LDA ECHOFLG ;in echo mode?
- ORA A
- JZ TERML ;if not, see if it was a 'CR'
- ;
- LTYPE MOV A,B ;get the character back
- CALL TYPE ;show on the local CRT
- CALL CKSAV ;to store local if buffer open
- CALL CHKPRNT ;put on printer if running
- ;
- CHKCR MVI A,CR
- CMP B
- JNZ TERML ;if not CR, all done
- LDA ECHOFLG ;in echo mode now?
- ORA A
- JNZ CHKLF ;if yes add a line feed
- LDA ADDLFD ;going to add a line feed in 'L' mode?
- ORA A
- JZ TERM ;if not, exit
- ;
- CHKLF MVI B,LF
- JMP NTOG ;send locally and to remote
- ;
- TERML CALL RCVRDY ;character on the receive-ready line?
- JNZ TERM ;if not, exit
- CALL I$MDDATP ;get the character
- ANI 7FH ;strip parity
- JZ TERM ;do not bother with nulls
- CPI RUB
- JZ TERM ;do not bother with rubouts for fill
- MOV B,A ;store temporarily
- LDA IGNRCTL ;ignoring all but necessary CTL-chars?
- ORA A
- JZ GIVLF ;if zero, display them all
- MOV A,B
- CPI ' '
- JNC GIVLF ;display all printing characters
- CPI 'G'-40H ;^G for bell
- JC TERM ;ignore CTL-characters less than ^G
- CPI CR+1
- JNC TERM ;ignore CTL-characters more than ^M
- ;
- GIVLF MOV A,B ;get the character back
- CALL TYPE ;show it on the CRT
- CALL CKSAV ;saving for disk file?
- CALL CHKPRNT ;printer running?
- LDA ECHOFLG ;going to echo the character?
- ORA A
- JZ NOECH ;if not, do not resend
- ;
- GIVLF1 CALL SNDCHR ;send character in 'B' to modem
- ;
- NOECH MVI A,CR
- CMP B ;was it a 'CR' just now?
- JNZ TERM ;if not, all done so exit
- LDA ECHOFLG ;in the echo mode?
- ORA A
- JZ TERM
- CALL SNDNOW ;modem ready for a character?
- MVI B,LF
- JMP GIVLF ;send LF
- ;
- ; See if putting character into memory for a disk file
- ;
- CKSAV LDA SAVEFLG ;saving to disk?
- ORA A
- RZ ;if not, exit
- LHLD HLSAV ;get last address
- MOV M,B ;store this character
- INX H ;increment for next character
- SHLD HLSAV ;remember that location
- MVI A,LF
- CMP B ;this character a line feed?
- JNZ CKSAV1 ; type ";" after each line feed
- MVI A,CR ;insure at left column with a LF
- CALL TYPE
- CALL TYPSEM ;show a ';' on CRT
- ;
- CKSAV1 MOV A,H
- LXI H,BUFTOP ;get the address at top of buffer
- CMP H
- CZ DCTLS ;if different, buffer is not full
- RET
- ;
- ; Memory buffer is full, send a X-OFF (CTL-S, DC3), save any extra in-
- ; coming characters, then dump to disk, reset buffer to include those
- ; characters.
- ;
- DCTLS CALL SNDNOW ;modem ready for a character?
- MVI A,XOFF ;send a CTL-S to stop remote computer
- CALL O$MDDATP
- CALL CHKPRNT ;insure character gets to the printer
- LXI H,BUFFDSK ;address of auxiliary buffer
- CALL GTDSK ;put any extra chars. into aux. buffer
- PUSH D ;save the number of aux. chars.
- MVI A,1 ;show we put something in the buffer
- STA WRFLG ; to protect erasing an empty file
- LHLD HLSAV ;find current end of buffer
- CALL WRDSK1 ;write the records
- POP D ;get auxiliary character count back
- LXI H,BUFFER ;start again at bottom of buffer
- XRA A ;set 'A' to zero
- CMP D ;see if any count in 'D'
- JZ DCTLQ ;if nothing, exit and continue
- LXI B,BUFFDSK ;address of auxiliary buffer
- ;
- ; Move the characters from the auxiliary buffer to the main buffer and
- ; display
- ;
- DCTLS1 LDAX B ;get the character there
- MOV M,A ;store in main buffer
- CALL TYPE ;show on CRT
- PUSH H
- PUSH D
- PUSH B
- PUSH PSW
- MOV B,A
- CALL CHKPRNT
- POP PSW ;get the character again
- POP B
- POP D
- POP H
- CPI LF
- CZ TYPSEM
- INX H ;next buffer position
- INX B ;next auxiliary buffer position
- DCR D ;one less to go
- JNZ DCTLS1 ;if not zero, keep going
- MVI B,0 ;falls through to 'CHKPRNT' next
- ;
- DCTLQ SHLD HLSAV ;next position to store in buffer
- CALL SNDNOW
- MVI A,XON ;allow remote input to continue
- JMP O$MDDATP
- ;
- ; Gets any incoming characters after sending an XOFF and stores at HL.
- ; Returns with number of characters stored in D-reg.
- ;
- GTDSK MVI D,0 ;character count in buffer
- MVI E,128 ;maximum for buffer length
- ;
- GTDSK1 CALL J$INMDM ;get any character
- RC ;if none, finished
- CPI ' '
- JNC GTDSK2 ;if greater, handle normally
- CPI CR+1 ;ignore CTL-characters > CR
- JNC GTDSK1
- ;
- GTDSK2 MOV M,A ;store
- INX H ;next buffer location to use
- INR D ;increment character count
- DCR E ;room for one less
- JNZ GTDSK1 ;if room in buffer, keep going
- RET ;if buffer is filled, exit
- ;
- ; See if printing the character, if yes, put into buffer
- ;
- CHKPRNT LDA LISTFLG ;printer in use?
- ORA A
- RZ ;return if not
- LHLD HLSAV1 ;get input address
- MOV M,B ;save this character there
- INX H ;increment the buffer location
- SHLD HLSAV1 ;store for next character
- LDA MAXRAM ;see if at top of buffer yet
- CMP H
- CZ PCTLS ;if different, buffer is not full
- RET
- ;
- ; Memory buffer is full, send a X-OFF (CTL-S, DC3), save any extra in-
- ; coming characters, then dump to disk, reset buffer to include those
- ; characters.
- ;
- PCTLS CALL SNDNOW ;wait until modem is ready
- MVI A,XOFF ;send a CTL-S to stop remote computer
- CALL O$MDDATP
- LXI H,BUFFPNT ;address of auxiliary buffer
- CALL GTDSK ;put any extra chars. into aux. buffer
- MOV A,D ;get the aux. buffer character count
- STA DSTORE ;save for later
- RET
- ;
- ; Output has now caught up to the input and both are at top of buffer
- ;
- PCTLS1 LDA DSTORE ;get the aux. buffer character count
- MOV D,A ;put into 'D' register
- XRA A ;set 'A' to zero
- CMP D ;see if any count in 'D'
- LXI H,PBUFF ;address at start of printer buffer
- JZ PCTLQ ;if nothing, exit and continue
- LXI B,BUFFPNT ;address of auxiliary buffer
- ;
- ; Move the characters from the aux. buffer to the main buffer and display
- ;
- PCTLS2 LDAX B ;get the character there
- MOV M,A ;store in main buffer
- CALL TYPE ;show on CRT
- PUSH H
- PUSH D
- PUSH B
- PUSH PSW
- MOV B,A
- CALL CKSAV
- POP PSW
- POP B
- POP D
- POP H
- CPI LF
- CZ TYPSEM
- INX H ;next buffer position
- INX B ;next auxiliary buffer position
- DCR D ;one less to go
- JNZ PCTLS2 ;if not zero, keep going
- ;
- PCTLQ SHLD HLSAV1 ;next position to store in buffer
- LXI H,PBUFF ;start of buffer location
- SHLD HLSAV2 ;output to start of buffer
- CALL SNDNOW ;wait until modem is ready
- MVI A,XON ;send start character
- JMP O$MDDATP ; to remote computer, back to work
- ;
- ; List the character on the printer if it is ready, then see if at the
- ; top of the buffer.
- ;
- GOLIST CALL $-$ ;get the printer status - filled in
- ORA A ;by 'INITAD' routine
- RZ ;return if printer not ready
- ;
- ; Compare input and output pointers. If at same address, nothing to
- ; print.
- ;
- CALL CMP$I$O ;if the same, nothing to print
- RZ
- ;
- ; If not the same, print the character
- ;
- GOLIST1 PUSH H ;save current buffer address
- MOV E,M ;get the character to display
- MVI C,LIST ;list routine
- CALL BDOS
- POP H ;restore current buffer address
- INX H ;increment pointer for next position
- SHLD HLSAV2 ;store for next time through here
- ;
- ; See if the output is at the end of the buffer now. If yes, go put
- ; the auxiliary characters into the start of the buffer.
- ;
- LDA MAXRAM ;check for end of buffer area
- CMP H
- JZ PCTLS1 ;if at end, restore auxiliary buffer
- ;
- ; See if the output has caught up with the input - if so, reset the
- ; pointers to the start of the buffer
- ;
- CALL CMP$I$O
- RNZ ;if not, back to work
- LXI H,PBUFF ;if output caught input, reset both
- SHLD HLSAV1 ; to bottom of buffer to start over
- SHLD HLSAV2
- RET
- ;
- ; Compare the input and output pointers to see if the same address
- ;
- CMP$I$O LHLD HLSAV1 ;get input pointer address
- XCHG ;put in 'DE'
- LHLD HLSAV2 ;get output pointer address
- MOV A,H
- CMP D
- RNZ ;return if different
- MOV A,L
- CMP E
- RET
- ;
- GTMAX LDA SAVCCP ;going to save 'CCP'?
- ORA A
- LDA BDOS+2 ;'MSP' of 'BDOS' address
- JZ GTMAX1
- SBI 8 ;'CCP' is 2k or 8 pages
- ;
- GTMAX1 STA MAXRAM ;save
- RET
- ;
- ; This subroutine will loop until the modem receives a character or 100
- ; milliseconds. It returns with a character in 'A' reg. but if no char-
- ; acter was recieved it returns after a timeout with carry set.
- ;
- INMDM PUSH H
- LXI H,63 ;about 100 milliseconds
- CALL FIXCNT
- MOV B,H ;delay is in 'HL'
- MOV C,L ;transfer to 'BC'
- POP H ;get original value of 'HL' back
- ;
- INMDM1 CALL RCVRDY ;see if there is a character ready
- JNZ INMDM2 ;if no character, exit
- CALL I$MDDATP ;get the character
- ANI 7FH ;strip off any parity
- RET ;return with character in 'A' reg.
- ;
- INMDM2 DCX B ;otherwise keep timing
- MOV A,B
- ORA C
- JNZ INMDM1 ;loop until timeout if needed
- STC ;shows a timeout occured
- RET
- ;
- ; Send a space tone to the phone line for a short time.
- ;
- BREAK LDA PMMIMD ;using the PMMI modem?
- ORA A
- JZ BREAK1 ;if not, exit
- LDA MDCTLB ;get the last modem control byte
- ANI BRKMASK ;set the transmit break bit low
- CALL O$MDCTL2 ;send it to the modem
- MVI B,2
- CALL TIMER ;send a space tone for 200 ms.
- LDA MDCTLB ;get the last modem control byte
- CALL O$MDCTL2 ;restore to normal
- JMP TERM ;back to work
- ;
- BREAK1 CALL J$BREAK ;get the user's break routine
- JMP TERM ;back to work
- ;
- ;=======================================================================
- ; WRITE BUFFER TO DISK
- ;
- ; Make sure this record is included in the count.
- ;
- WRDSK LHLD HLSAV
- MVI M,EOFCHAR ;ASCII file, store end-of-file char.
- LXI D,127
- DAD D
- ;
- WRDSK1 LXI D,-(BUFFER) ;subtract the start of the buffer
- DAD D ;by adding a minus number to buffer end
- MOV A,L ;divide hl by 128
- ORA A
- RAL ; to get the
- MOV L,H ; number of records
- MVI H,0
- PUSH PSW
- DAD H
- POP PSW
- MVI A,0
- ADC L
- MOV L,A ;number of records in 'HL'
- ;
- ; See if buffer is empty. If yes, see if we need to erase an empty
- ; file or have already written something.
- ;
- LXI D,BUFFER
- LDAX D
- CPI EOFCHAR ;'EOF' in first address means
- JNZ WRDSK2 ; nothing in buffer to write
- LDA WRFLG ;first time by this way?
- ORA A
- JZ NOWRITE ;if yes, show erasing file
- RET ;otherwise go close file
- ;
- ; Write to disk. Start from BUFFER (in 'DE'). Number of records to
- ; write in 'HL'.
- ;
- WRDSK2 MVI C,STDMA
- CALL BDOSRT
- PUSH D
- MVI C,WRITE
- LXI D,FCB3 ;location of filename to write to
- CALL BDOSRT
- POP D
- ORA A
- JNZ WRERRSP ;error if disk is full ** special patch
- XCHG ;put the current address in 'HL'
- PUSH D ; and number of records left in
- LXI D,128 ; for now
- DAD D ;add for next record write, now in 'HL'
- POP D ;restore number of records left
- XCHG ;records to 'HL' again, address to 'DE'
- DCX H ;one less record left
- MOV A,H
- ORA L ;done writing when 'H' and 'H' both zero
- JNZ WRDSK2 ;otherwise do another disk write
- RET
- ;
- ; Error while writing a record, show why it is aborting
- ;
- WRERR MVI C,CANCEL ;send cancel char. to sending station
- CALL SND
- CALL CLOSFIL ;close the current file
- ;
- WRERR1 CALL ERXIT ;also will reset stack
- DB '++ DISK FULL, SAVING PARTIAL FILE ++','$'
- ;
- ; If no data to store on the disk, close the empty file and erase it
- ;
- NOWRITE CALL WRFIL2 ;close the empty file
- CALL NOASK ;erase the empty file
- CALL ILPRT
- DB '++ Nothing to save, erasing file ++'
- DB CR,LF,BELL,0
- JMP DONETA ;reset any flags, return to menu
- ;
- ; Show you are in memory-save for disk write
- ;
- TYPSEM MVI A,';'
- JMP TYPE ;show on CRT, return
- ;
- ; Save the registers, call BDOS then restore the registers
- ;
- BDOSRT PUSH B
- PUSH D
- PUSH H
- CALL BDOS
- POP H
- POP D
- POP B
- RET
- ;
- INITFCB MVI M,0 ;entry at +2 will leave drive # intact
- INX H ;will initialize an FCB
- MVI B,11 ;pointed to by HL-reg. fills 1st pos.
- ;
- LOOP11 MVI M,' ' ; with 0, next 11 with
- INX H ; with blanks, and last
- DCR B ; 21 with nulls
- JNZ LOOP11
- MVI B,21
- ;
- LOOP21 MVI M,0
- INX H
- DCR B
- JNZ LOOP21
- RET
- ;
- ; Scans CMDBUF counting names and putting delimiter (space) after last
- ; name.
- ;
- SCAN PUSH H
- LXI H,NAMECT
- MVI M,0
- LXI H,CMDBUF+1 ;find end of command line, add space
- MOV C,M
- MVI B,0
- LXI H,CMDBUF+2
- DAD B
- MVI M,' '
- LXI H,CMDBUF+1
- MOV B,M
- INR B
- INR B
- ;
- SCANL1 INX H
- DCR B
- JZ DNSCAN
- MOV A,M
- CPI ' '
- JNZ SCANL1
- ;
- SCANL2 INX H ;eat extra spaces
- DCR B
- JZ DNSCAN
- MOV A,M
- CPI ' '
- JZ SCANL2
- SHLD BGNMS ;save start of names in CMDBUF
- INR B
- DCX H
- ;
- SCANL3 INX H
- DCR B
- JZ DNSCAN
- MOV A,M
- CPI ' '
- JNZ SCANL3
- LDA NAMECT ;counts names
- INR A
- STA NAMECT
- ;
- SCANL4 INX H ;eat spaces
- DCR B
- JZ DNSCAN
- MOV A,M
- CPI ' '
- JZ SCANL4
- JMP SCANL3
- ;
- DNSCAN MVI M,' ' ;space after last character
- POP H
- RET
- ;
- ; 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 characterss 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
- ;
- CKCPM2 MVI C,CPMVER ;BDOS 12 -- version number -- cp/m 2.x?
- CALL BDOS
- ORA A
- RZ
- MVI C,STDMA
- LXI D,TBUF
- CALL BDOS
- MVI C,SRCHF
- LXI D,FCB
- CALL BDOS
- CPI 0FFH
- RZ
- ;
- CALL GETADD
- LXI D,9
- DAD D ;point to R/O attribute byte
- MOV A,M
- ANI 80H ;test most significant byte
- JNZ MKCHG ;if set, make change
- INX H ;check system attribute byte
- MOV A,M
- ANI 80H
- RZ ;not SYS or R/O attribute
- DCX H
- ;
- MKCHG LXI D,-8
- DAD D ;point HL to filename + 1
- LXI D,FCB+1 ;move directory name to FCB
- MVI B,11 ; without changing drive
- CALL MOVE
- LXI H,FCB+9 ;R/O attribute
- MOV A,M
- ANI 7FH ;strip R/O attribute
- MOV M,A
- INX H ;system attribute
- MOV A,M
- ANI 7FH
- MOV M,A
- LXI D,FCB
- MVI C,30 ;set new attributes in directory
- CALL BDOS
- ;
- ; Called by 'CKBAKUP' below, return done here through 'BDOS' jump
- ;
- PLANCHG LXI H,FCB ;change name to type "BAK"
- LXI D,FCB2
- MVI B,9 ;move drive and name (not type)
- CALL MOVE
- LXI H,75H ;start of type in FCB2
- MVI M,'B'
- INX H
- MVI M,'A'
- INX H
- MVI M,'K'
- LXI D,FCB2
- MVI C,ERASE ;erase any previous backups
- CALL BDOS
- LXI H,FCB2 ;FCB2 drive field should have
- MVI M,0
- LXI D,FCB
- MVI C,23 ;rename
- JMP BDOS
- ;
- CKBAKUP LDA BACKUP
- ORA A
- RZ
- MVI C,SRCHF
- LXI D,FCB
- CALL BDOS
- INR A
- RZ ;file not found
- JMP PLANCHG ;in 'CKCPM2' - return done there
- ;
- ;***********************************************************************
- ; RECEIVE A RECORD FROM SENDING STATION
- ;***********************************************************************
- ;
- ; If CRC is in effect, there is a 10-second timeout to the first SOH.
- ; It then tries six more times to let the sender know the system is
- ; capable of receiving a 'CRC' check. At the end of that time a NAK is
- ; sent which tells the sender to use CHECKSUM checking instead of CRC.
- ; This allows automatic compatability with systems implementing CRC -
- ; (Cyclic Redundancy Checking). The search for SOH will cycle through
- ; one record interval and ignore noise or characters sent by the remote
- ; for any purpose (such as progress reporting). So extraneous characters
- ; that are sometimes sent by remote-end protocol will be gobbled up until
- ; the first SOH. EOT is tested only as the first returned character af-
- ; ter each sector.
- ;
- SRCHSOH EQU 160 ;number of times to loop search for SOH
- ;
- RCVRECD MVI A,1
- STA ERRCT ;initialize the error count
- ;
- RCVSQ MVI B,10 ;10 seconds allowed to receive 1st char.
- LXI D,SRCHSOH ;initialize loop for up to 160 seconds
- CALL RECV ;get the 1st character
- JC RCVSTOT ;timeout error if not rcvd in 10 seconds
- MOV C,A ;save the character for now
- CPI EOT ;see if end of transmission
- STC ;set carry
- RZ ;return with carry set
- ;
- SOHLUP MVI A,0FFH
- STA CHRFLG
- STA TIMFLG
- MOV A,E ;get search count-down value
- CPI SRCHSOH ;see if it is the 1st returned character
- MOV A,C ;get the first character now
- JZ NORECV ;skip RECV routine if 1st character
- MVI B,1
- CALL RECV
- MOV B,A
- JNC TSTSOH
- ;
- NORECV MOV B,A
- XRA A ;else set the value that forces timeout
- STA CHRFLG
- ;
- TSTSOH MOV A,B ;get the character
- CPI SOH ;see if it is SOH
- PUSH PSW
- XRA A
- STA TIMFLG ;restore this flag
- POP PSW
- JZ RCVSOH ;got SOH, get rcd # and its complement
- MOV A,D
- ORA E ;see if counted-down to zero
- DCX D
- JNZ SOHLUP ;go around again if not
- LDA CHRFLG ;see if timeout needs to be forced
- ORA A
- JZ RCVSTOT ;go do timeout and count them
- LDA QFLG
- ORA A
- JZ RCVSRR
- ;
- RCVSH CALL CRLF
- MOV A,B
- CALL HEXO
- CALL ILPRT
- DB 'H received not SOH - ',0
- ;
- RCVPRN CALL SHOERR ;display error count
- ;
- RCVSRR CALL WAITQ1 ;wait for 1 second with no characters
- CALL CKABORT ;want to stop receiving now?
- LDA CRCFLAG ;get 'CRC' flag
- ORA A ;'CRC' in effect?
- MVI A,NAK ;put 'NAK' in 'A' register
- JZ RCVSR1 ;no, send the 'NAK'
- LDA FIRSTME ;get first time switch
- ORA A ;has first 'SOH' been received?
- MVI A,NAK ;put 'NAK' in 'A' register
- JNZ RCVSR1 ;yes, then send 'NAK'
- MVI A,CRC ;tell sender 'CRC' is in effect
- ;
- RCVSR1 CALL SND ; the 'NAK' or 'CRC' request
- LDA ERRCT ;abort if we have reached error limit
- INR A
- STA ERRCT ;store for next time
- CPI ERRLIM ;see if at limit yet
- JC RCVSQ ;if not, keep going
- LDA RETRY ;see if retry after 10 errors is set
- ORA A
- JZ ABORT ;if 'YES', abort
- JMP CKQIT ;if 'NO' check for continued use
- ;
- RCVSABT LXI SP,STACK ;reset the stack just in case
- CALL CLOSFIL ;close the partial file
- CALL NOASK ;delete partial file
- CALL ILPRT
- DB CR,LF,LF
- DB '++ RECEIVED FILE CANCELLED ++',CR,LF,BELL
- DB '++ UNFINISHED FILE DELETED ++',CR,LF,0
- JMP DONETA
- ;
- RCVSTOT LDA QFLG
- ORA A
- JZ RCVSCC
- ;
- RCVSPT CALL ILPRT
- DB CR,LF,'++ Timeout ',0
- CALL SHOERR
- ;
- RCVSCC CALL RCVSCC2
- JMP RCVSRR
- ;
- ; Routine will switch from 'CRC' to Checksum if 'ERCNT' reaches 'ERRCRC'
- ; and 'FIRSTIME' is false.
- ;
- RCVSCC2 LDA ERRCT
- CPI ERRCRC
- RNZ
- LDA FIRSTME
- ORA A
- RNZ
- LDA CRCFLAG
- ORA A
- RZ
- CMA
- STA CRCFLAG
- STA CRCDFLT
- CALL ILPRTQ
- DB '** Switching to Checksum mode **',CR,BELL,LF,0
- RET
- ;
- ; Got SOH - get block #, block # complemented
- ;
- RCVSOH MVI A,0FFH
- STA FIRSTME ;indicate 1st soh was received
- MVI B,5 ;timeout = 5 seconds
- CALL RECV ;get record
- JC RCVSTOT ;got timeout
- MOV D,A
- MVI B,5 ;timeout = 5 seconds
- CALL RECV
- JC RCVSTOT
- CMA
- CMP D
- JZ RCVDATA
- LDA QFLG
- ORA A
- JZ RCVSRR
- ;
- RCVBSE CALL ILPRT
- DB CR,LF,'++ Bad record # in header ',0
- JMP RCVPRN
- ;
- RCVDATA MOV A,D
- STA RCVRNO
- MVI A,1
- STA DATAFLG
- MVI C,0
- LXI H,0
- SHLD CRCVAL
- LXI H,80H
- ;
- RCVCHR MVI B,5 ;wait up to 5 seconds for a character
- CALL RECV
- JC RCVSTOT
- MOV M,A
- INR L
- JNZ RCVCHR
- XRA A
- STA DATAFLG
- LDA CRCFLAG
- ORA A
- JNZ RCVCR
- MOV D,C
- MVI B,5 ;wait up to 5 seconds for an answer
- CALL RECV
- JC RCVSTOT
- CMP D
- JNZ RCVCERR
- ;
- CHKSNUM LDA RCVRNO
- MOV B,A
- LDA RECNO
- CMP B
- JZ RCVACK
- INR A
- CMP B
- JNZ ABORT
- RET
- ;
- RCVCR MVI E,2 ;number of 'CRC' bytes
- ;
- RCVCR2 MVI B,5 ;wait up to 5 seconds for a character
- CALL RECV
- JC RCVSTOT
- DCR E
- JNZ RCVCR2
- CALL CRCCHK
- ORA A
- JZ CHKSNUM
- LDA QFLG
- ORA A
- JZ RCVSRR
- ;
- RCVCRER CALL ILPRT
- DB '++ CRC error ',0
- JMP RCVPRN
- ;
- RCVCERR LDA QFLG
- ORA A
- JZ RCVSRR
- ;
- RCVCPR CALL ILPRT
- DB '++ CHECKSUM error ',0
- JMP RCVPRN
- ;
- RCVACK CALL SNDACK
- JMP RCVRECD
- ;
- ; Get the error count and display on CRT
- ;
- SHOERR PUSH H
- LHLD ERRCT
- MVI H,0
- CALL DECOUT
- POP H
- CALL ILPRT
- DB ' ++',CR,LF,0
- LDA ERRCT
- CPI ERRLIM
- JNC ABORT
- RET
- ;
- SNDHDR LDA QFLG
- ORA A
- JZ SNDHNM
- CALL ILPRT
- DB CR,'Sending # ',0
- PUSH H ;store current address
- LHLD RECNO ;get record number
- CALL DECOUT ;print it in decimal
- CALL ILPRT
- DB ' ',0
- ;
- LDA HEXSHO
- ORA A
- JZ SNDHNM-1
- CALL ILPRT
- DB '(',0
- CALL DHXOUT ;16 bit hex conversion & output
- CALL ILPRT
- DB 'H) ',0
- ;
- POP H ;restore current address
- ;
- SNDHNM MVI A,SOH ;send 'SOH' character to the output
- CALL SND
- LDA RECNO ;send record number to the output
- CALL SND
- LDA RECNO
- CMA ;complement the record number
- JMP SND ;send this value to the output
- ;
- SNDREC MVI A,1
- STA DATAFLG
- MVI C,0
- LXI H,0 ;new record, clear 'CHECKSUM' value
- SHLD CRCVAL ;new record, clear 'CRC' value
- LXI H,TBUF ;store at 0080H
- ;
- SNDC MOV A,M
- CALL SND
- INR L
- JNZ SNDC
- XRA A
- STA DATAFLG
- RET
- ;
- SNDCKS MOV A,C
- JMP SND
- ;
- SNDCRC PUSH H
- LHLD CRCVAL
- MOV A,H
- CALL SND
- MOV A,L
- CALL SND
- POP H
- XRA A ;reset the carry bit
- 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. The GTACK routine can gobble up a string of up to 191
- ; characters while searching for an 'ACK' or a 'NAK'.
- ;
- GTACK MVI E,192 ;number of characters to gobble
- ;
- ACKLUP MVI A,0FFH
- STA CHRFLG ;set the character flag
- STA TIMFLG ;set the time flag
- MVI B,1
- CALL RECV
- MOV B,A ;save the character
- JNC ACKTST
- XRA A
- STA CHRFLG ;reset the character flag, was none
- ;
- ACKTST XRA A
- STA TIMFLG
- MOV A,B ;get the character back
- CPI ACK
- RZ
- CPI NAK
- JZ GTACK1
- ;
- NOAKNK DCR E ;one less to go
- JNZ ACKLUP ;loop around again if not zero
- LDA CHRFLG
- ORA A
- JZ GETATOT
- ;
- GTACK1 LDA BENHERE
- XRA B
- JZ ACKER0 ;do not say 'ACK error' if 1st 'NAK'
- LDA QFLG
- ORA A
- JZ ACKER
- CALL ILPRT
- DB '++ ',0
- MOV A,B
- CPI NAK
- JZ GTACK3
- CALL HEXO
- CALL ILPRT
- DB 'H',0
- JMP GTACK4
- ;
- GTACK3 CALL ILPRT
- DB 'NAK',0
- ;
- GTACK4 CALL ILPRT
- DB ' received not ACK - ',0
- CALL SHOERR
- ;
- ACKER0 XRA A
- STA BENHERE
- ;
- ACKER LDA ERRCT
- INR A
- STA ERRCT
- CPI ERRLIM+1 ;at error limit yet?
- RC ;if not, return
- ;
- ACKER1 CALL ERXIT
- DB CR,LF,'++ SEND-FILE CANCELLED ++','$'
- ;
- ; Reached error limit
- ;
- GETATOT CALL ILPRT
- DB CR,'++ TIMEOUT - no ACK - ',0
- CALL SHOERR ;display error count
- JMP ACKER
- ;
- CKABORT LDA QFLG
- ORA A
- RZ
- CALL STAT
- RZ
- CALL KEYIN
- CPI CANCEL
- RNZ
- ;
- ; Aborts send or receive routines and returns to command line
- ;
- ABORT LXI SP,STACK
- ;
- ABORTL MVI B,1 ;1-second delay to clear input
- CALL RECV
- JNC ABORTL
- MVI A,CANCEL ;show you are cancelling
- CALL SND
- ;
- ABORTW MVI B,1 ;1-second delay to clear input
- CALL RECV
- JNC ABORTW
- MVI A,' '
- CALL SND
- MVI A,'B' ;turn multi-file mode
- STA BCHFLG ; off so routine ends
- STA ABTFLG ;shows an abort was made
- XRA A
- STA NFILFLG ;stop copy into memory for disk file
- LDA OPTION ;receiving a file now?
- CPI 'R'
- JZ RCVSABT ;if yes, cancel the unfinished file
- CALL ILPRT
- DB CR,LF,LF,'++ FILE CANCELLED ++',CR,LF,BELL,0
- JMP DONETA
- ;
- ; Increment the record count
- ;
- INCRRNO PUSH H
- LHLD RECNO ;get record number
- INX H ;bump it
- SHLD RECNO ;store it
- MOV A,L
- POP H
- RET
- ;
- ; First check for any wild cards and disallow, just to be safe. Do not
- ; want a group of files being accidently erased.
- ;
- ERASF LXI H,FCB ;file name is stored here
- MVI B,11 ;maximum of 11 chars for filename.ext
- ;
- ERASF1 INX H ;next location in file name
- MOV A,M ;get the char.
- CPI '?' ;check for any wild card characters
- JZ ERRORW ;error if one is found
- DCR B ;number of tries left
- JNZ ERASF1 ;if not zero, keep checking
- LDA BCHFLG ;do not ask for erase
- ORA A ; in multi-file mode,
- JZ NOASK ; just do it
- LXI D,FCB
- MVI C,SRCHF
- CALL BDOS
- INR A
- RZ ;file erased ok, return
- CALL ILPRT ;otherwise make sure it is ok
- DB 'File exists - erase? (Y/N): ',BELL,0
- CALL KBDCHR
- CPI 'Y'
- JNZ MENU ;if not a 'Y' do not erase
- CALL CRLF ;otherwise erase the file
- ;
- NOASK LXI D,FCB
- MVI C,ERASE
- JMP BDOS
- ;
- ERRORW POP H ;restore stack from "call ERASF"
- CALL ILPRT
- DB '++ NO WILDCARDS ALLOWED FOR TEXT FILES ++'
- DB CR,LF,BELL,0
- JMP MENU
- ;
- BLKFILE CALL ILPRT ;no file named for send or receive
- DB '++ NO FILE SPECIFIED ++',CR,LF,BELL,0
- JMP MENU
- ;
- MAKEFIL LXI D,FCB
- MVI C,MAKE
- CALL BDOS
- INR A
- RNZ
- CALL ERXIT
- DB '++ ERROR -- Can''t open file ++',CR,LF
- DB '++ Directory is perhaps full ++','$'
- ;
- CNREC MVI C,FILSIZ ;compute file size function in CP/M 2.x
- LXI D,FCB ;point to file control block
- CALL BDOS
- LHLD FCB+33 ;get record count
- SHLD RCNT ;store it
- LXI H,0 ;zero 'HL'
- SHLD FCB+33 ;reset random record in FCB
- RET
- ;
- OPENFIL XRA A
- STA FCBEXT
- LXI D,FCB
- MVI C,OPEN
- CALL BDOS
- INR A
- JNZ SNDTM ;send transfer time, # of records, etc.
- CALL ERXIT ;file did not open
- DB '++ FILE NOT FOUND ++','$'
- ;
- CLOSFIL LXI D,FCB ;get the file name
- MVI C,CLOSE
- CALL BDOS ;close the file
- INR A
- RNZ
- JMP ERXIT1 ;no file to close, exit
- ;
- ; Update record read
- ;
- RDRECD LDA RECINBF ;decrement 'RECORDS IN BUFFER' count
- DCR A
- STA RECINBF
- JM RDBLOCK
- LHLD RECPTR ;find where last move stopped
- LXI D,128
- CALL MOVE128 ;move 128 characters
- SHLD RECPTR ;store new address for next move
- RET
- ;
- ; Buffer empty so read in another block from the disk
- ;
- RDBLOCK LDA EOFLG
- CPI 1
- STC
- RZ
- MVI C,0
- LXI D,BUFFER
- ;
- RDRECLP PUSH B
- PUSH D
- MVI C,STDMA
- CALL BDOS
- LXI D,FCB
- MVI C,READ
- CALL BDOS
- POP D
- POP B
- ORA A
- JZ RDRECOK
- DCR A
- JZ REOF
- CALL ERXIT
- DB '++ FILE READ ERROR ++','$'
- ;
- RDRECOK LXI H,128
- DAD D
- XCHG
- INR C
- CALL DSKSIZ ;establish buffer size
- JZ RDBFULL
- JMP RDRECLP
- ;
- REOF MVI A,1
- STA EOFLG
- MOV A,C
- ;
- ; Buffer full or received "End Of File (EOF)"
- ;
- RDBFULL STA RECINBF
- LXI H,BUFFER
- SHLD RECPTR
- MVI C,STDMA
- LXI D,TBUF
- CALL BDOS
- JMP RDRECD
- ;
- ; Write a record
- ;
- WRRECD LHLD RECPTR
- XCHG
- LXI H,128
- CALL MOVE128
- XCHG
- SHLD RECPTR ;new record pointer
- LDA RECINBF ;increment 'RECORDS IN BUFFER' count
- INR A
- STA RECINBF
- MOV C,A ;store the record count for now
- CALL DSKSIZ ;establish buffer size
- RNZ ;buffer not full, return
- ;
- ; Write a block to disk
- ;
- WRBLOCK LDA RECINBF ;get the number of records in the buffer
- ORA A
- RZ ;if zero, don't try to move to disk
- MOV C,A ;otherwise store in 'C' register
- LXI D,BUFFER ;start of buffer to move to disk
- ;
- DSKWRT PUSH B
- PUSH D
- PUSH H
- MVI C,STDMA
- CALL BDOS
- MVI C,WRITE
- LXI D,FCB
- CALL BDOS
- POP H
- POP D
- POP B
- ORA A
- JNZ WRERR ;error if disk is full
- LXI H,128 ;add in another page
- DAD D
- XCHG
- DCR C ;one less record left to move to disk
- JNZ DSKWRT
- XRA A
- STA RECINBF ;zero the 'RECORDS IN BUFFER' count
- LXI H,BUFFER ;reset location to next buffer start
- SHLD RECPTR
- RET
- ;
- ; Determine if the buffer size is for file transfer or for ASCII capture
- ; to disk then compare with current record length
- ;
- DSKSIZ LDA XFLG ;see if transferring files now
- ORA A
- MOV A,C ;get the current record count
- JZ DSKSIZ1 ;if yes, exit
- MOV A,C
- CPI BUFSIZ*8 ;buffer size for ASCII capture to disk
- RET ;return with flag set for the compare
- ;
- DSKSIZ1 LDA SAVSIZ ;get the file transfer buffer size..
- CMP C ;..from special storage area and compare
- RET ;return with flag set for the compare
- ;
- ; Timeout time is in B, in seconds. Entry via 'RECVDG' deletes garbage
- ; characters on the line. For example, having just sent a record, cal-
- ; ling RECVDG will delete any line noise induced characters LONG before
- ; the ACK/NAK would be received.
- ;
- RECVDG CALL CKCHAR ;catch any garbage characters
- ;
- RECV PUSH D
- ;
- ; Get back quickly to gobble 2nd character if TIMFLG is set by the GETNM
- ; routine - or just step through quickly after the first wait for 'SOH'
- ; in the 'SOHLUP' routine.
- ;
- MSEC PUSH H
- LXI H,TIMFLG
- MOV E,M
- INR E
- LHLD QUIKTIM
- JZ DOQUIK
- LHLD TIMVAL
- ;
- DOQUIK XCHG
- POP H
- ;
- MWTI CALL RCVRDY
- JZ MCHAR
- MOV A,D
- ORA E
- DCX D
- JNZ MWTI
- DCR B
- JNZ MSEC
- POP D
- CALL CKABORT
- STC
- RET
- ;
- ; Get the character from the modem, but filter out 'ACK' and '.' chars.
- ; if receiving a file name. ('FILTRFLG' is set by the 'GETNM' routine.)
- ;
- MCHAR CALL I$MDDATP ;get the character that is waiting
- POP D
- PUSH PSW ;save the character for later use also
- CPI ACK ;see if it is 'ACK'
- JZ ISACK
- CPI '.' ;see if it is a period
- JNZ DOUPD ;neither, so update 'CRC'
- ;
- ISACK PUSH H
- PUSH D
- LXI H,FLTRFLG ;see if need to each 'ACK' or period
- MOV E,M
- INR E
- POP D
- POP H
- JZ MWTI ;yes, so do it
- ;
- DOUPD CALL CRCUPD ;calculate 'CRC'
- ADD C
- MOV C,A
- LDA RSEEFLG
- ORA A
- JZ MONIN
- LDA VSEEFLG
- ORA A
- JNZ NOMONIN
- LDA DATAFLG
- ORA A
- JZ NOMONIN
- ;
- MONIN POP PSW ;get the character again
- PUSH PSW ;resave it for later use also
- CALL SHOW ;show the character on the CRT
- ;
- NOMONIN CALL CKABORT
- POP PSW ;get the character back once more
- ORA A ;reset the carry flag
- RET ;return with the character and flag set
- ;
- ; Send a character to the modem
- ;
- SND PUSH PSW
- LDA SSEEFLG
- ORA A
- JZ MONOUT
- LDA VSEEFLG
- ORA A
- JNZ NOMONOT
- LDA DATAFLG
- ORA A
- JZ NOMONOT
- ;
- MONOUT POP PSW
- PUSH PSW
- CALL SHOW
- ;
- NOMONOT POP PSW
- PUSH PSW
- CALL CRCUPD ;update the 'CRC' calcuation
- ADD C
- MOV C,A
- ;
- SNDW CALL SNDRDY
- JNZ SNDW
- POP PSW
- JMP O$MDDATP ;send character to modem, done
- ;
- ; Waits for the first character received while waiting to send a file.
- ; If a character is not received in one second, it loops again until a
- ; char. is received or it times out. The count is set for two minutes
- ; before timeout. This gives the receiving station ample time to name
- ; a file, etc.
- ;
- WAITNAK CALL ILPRT
- DB 'Waiting ready signal',CR,LF,0
- CALL CRLF
- ;
- WAITNLP CALL CKABORT
- MVI B,1 ;wait up to 1 second for a character
- CALL RECV
- CPI CANCEL ;want to quit?
- JZ ABORT
- CPI CRC ;'CRC' request?
- JZ WAITCRC ;yes, go set 'CRC' flag
- CPI NAK
- JZ WAICK
- DCR E
- JNZ WAITNLP
- JMP ABORT
- ;
- WAITCRC CALL ILPRTQ
- DB 'CRC request received',CR,LF,0
- MVI A,1
- STA CRCFLAG ;make sure in 'CRC' mode then
- RET
- ;
- WAICK LDA BCHFLG ;in batch mode?
- ORA A
- RZ
- CALL ILPRTQ
- DB 'Got checksum request',CR,LF,0
- RET
- ;
- WAICK1 CALL ILPRTQ
- DB 'Name NAK received',CR,LF,0
- RET
- ;
- ; Finished with the file transfer
- ;
- DONE LDA BCHFLG ;in batch mode?
- ORA A
- JNZ DONET ;exit if not
- LDA QFLG
- ORA A
- JZ NMSTRNS
- MVI B,12 ;zero out FTRNM
- LXI H,FTRNM
- MVI A,0
- ;
- ZEROLP MOV M,A
- INX H
- DCR B
- JNZ ZEROLP
- MVI B,12 ;put file name in FTRNM
- LXI H,FCB+1
- LXI D,FTRNM
- ;
- LOADMSG MVI A,4 ;start of file type?
- CMP B
- JZ PERIOD ;put in period if so
- MOV A,M
- CPI ' '
- JZ SKPSP
- STAX D ;store in FTRNM
- INX D
- ;
- SKPSP INX H
- DCR B
- MOV A,B
- ORA A ;end of file name?
- JZ FTRNM0 ;display file name
- JMP LOADMSG ;loop for another character
- ;
- PERIOD MOV A,M
- CPI ' ' ;is file type empty?
- JZ FTRNM0 ;go if so
- MVI A,'.' ;else put period in message
- STAX D
- INX D
- DCR B
- JMP LOADMSG
- ;
- FTRNM0 CALL ILPRT
- DB CR,LF
- ;
- FTRNM DS 12
- DB 0
- CALL ILPRT
- DB ' Transferred',CR,LF,LF,BELL,0
- ;
- NMSTRNS LDA FCB ;save drive number
- STA DISKNO
- LXI H,FCB ;blank out file control blocks
- CALL INITFCB
- LDA DISKNO ;put drive number back
- STA FCB
- LXI H,RESTSN ;restore record numbers
- LXI D,RECNOB ; for new file transfer
- MVI B,RECNOE-RECNOB ;routine also done in menu
- CALL MOVE
- CALL SNDNOW ;insures last character is finished
- CALL CKCHAR ;catch any echo characters on line
- LDA SNDFLG ;goes to either send or
- ORA A ; receive file, depending
- JNZ SNDFL2 ; upon which routine set
- JMP RCVFL1 ; the flag in multi-file mode
- ;
- DONET CALL CKABORT ;slight delay for next message
- CALL ILPRT
- DB CR,LF,'[Transfer completed]',CR,LF,BELL,0
- ;
- DONETA LDA XITFLG ;special 'X' flag set?
- ORA A
- JZ BYEBYE ;if yes, disconnect and reboot
- LDA DISCFLG ;normal 'D' flag set?
- ORA A
- JZ DONETD ;if yes, disconnect, get next command
- ;
- DONETB CALL J$NPARIT ;reset to no parity
- XRA A
- STA CRCFLAG ;reset back to checksum
- STA FIRSTME ;reset first-time 'SOH' flag
- STA FSTFLG ;reset multi-file trans
- STA NFILFLG ;turn off the memory save for disk file
- STA SAVEFLG ;stop memory save in term routine.
- LDA VSEEFLG ;view flag set?
- ORA A
- JNZ DONETC ;if not, exit
- CMA
- STA QFLG ;VSEEFLG also sets the QFLG
- STA VSEEFLG ;reset the flag
- ;
- DONETC LXI H,QFLG ;in quiet mode?
- MOV A,M
- ORA A
- MVI M,'Q' ;reset the flag to normal
- JZ MENU ;if yes, go back to command line
- LDA ABTFLG ;come here from a timeout?
- ORA A
- JNZ MENU ;if yes, go to command mode
- LDA JMPCMD ;requesting return to command mode?
- ORA A
- JZ MENU ;if yes go to command mode
- CALL CRLF ;turn up a new line
- JMP TERM ;otherwise return to terminal mode
- ;
- DONETD CALL ILPRT
- DB CR,LF,'<< DISCONNECTED >>',BELL,CR,LF,0
- CALL J$GOODBY ;set 'DTR' low for 300 ms.
- LDA PMMIMD
- ORA A
- ;;; CNZ J$GOODBY
- DB 0,0,0 ;(PREVENT DOUBLE DISCONNECT)
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- ;;; CNZ J$GOODBY ;if yes, disconnect
- DB 0,0,0 ;(PREVENT DOUBLE DISCONNECT)
- JMP MENU0 ;back to command line
- ;
- MOVEFCB LXI H,FCB+16
- LXI D,FCB
- MVI B,16
- CALL MOVE
- XRA A
- STA FCBSNO
- STA FCBEXT
- RET
- ;
- SHOW CPI LF
- JZ CTYPE
- CPI CR
- JZ CTYPE
- CPI 9
- JZ CTYPE
- CPI ' '
- JC SEEHEX
- CPI 7FH
- JC CTYPE
- ;
- SEEHEX PUSH PSW
- MVI A,'('
- CALL CTYPE
- POP PSW
- CALL HEXO
- MVI A,')'
- JMP CTYPE
- ;
- CTYPE PUSH B
- PUSH D
- PUSH H
- MOV E,A
- MVI C,WRCON
- CALL BDOS
- POP H
- POP D
- POP B
- RET
- ;
- CRLF PUSH PSW
- MVI A,CR
- CALL TYPE
- MVI A,LF
- CALL TYPE
- POP PSW
- RET
- ;
- STAT PUSH B
- PUSH D
- PUSH H
- ;
- VSTAT CALL $-$ ;BIOS constat address, filled in
- POP H ; by 'INITAD' routine
- POP D
- POP B
- ORA A
- RET
- ;
- KEYIN PUSH B
- PUSH D
- PUSH H
- ;
- VKEYIN CALL $-$ ;BIOS 'CONIN' address, filled in
- POP H ; by 'INITAD' routine
- POP D
- POP B
- RET
- ;
- TYPE PUSH PSW
- PUSH B
- PUSH D
- PUSH H
- MOV C,A
- ;
- VTYPE CALL $-$ ;BIOS 'CONOUT' address, filled in
- POP H ; by 'INITAD' routine
- POP D
- POP B
- POP PSW
- RET
- ;
- ; Get a character from the keyboard, convert to upper-case if needed,
- ; and show on CRT
- ;
- KBDCHR CALL KEYIN ;get a keyboard character
- CALL UCASE ;convert to upper case if needed
- CALL TYPE ;show on CRT
- 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
- ;
- DECOUT PUSH PSW
- PUSH B
- PUSH D
- PUSH H
- LXI B,-10
- LXI D,-1
- ;
- DECOU1 DAD B
- INX D
- JC DECOU1
- 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
- POP PSW
- RET
- ;
- ;----> DHXOUT: - double precision hex output routine
- ;
- DHXOUT PUSH H
- PUSH PSW
- MOV A,H ;get MS byte
- CALL HEXO ;output high order byte
- MOV A,L ;get LS byte
- CALL HEXO ;output low order byte
- POP PSW
- POP H
- 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
- ;
- ; Displays the control-characters shown in the menu
- ;
- SHFTYPE PUSH PSW
- CALL ILPRT
- DB 'CTL-',0
- POP PSW
- ADI 40H ;convert binary to ASCII chars.
- CALL TYPE ;show on the CRT
- JMP ILPRT
- ;
- ; Write a string of characters to the CRT
- ;
- ILPRT XTHL
- ;
- ILPRT1 MOV A,M ;get the character
- ORA A ;see if a "0" for end of string
- JZ ILPRT2 ;if yes, all done
- CALL CTYPE ;show on CRT
- INX H ;get the next location in the string
- JMP ILPRT1
- ;
- ILPRT2 XTHL ;restore the address
- RET
- ;
- ; Write a string of characters unless in the Quiet mode
- ;
- ILPRTQ XTHL
- ;
- ILPRTQ1 MOV A,M ;get the character
- ORA A ;see if a "0" for end of string
- JZ ILPRTQ2 ;if yes, all done
- LDA QFLG
- ORA A
- MOV A,M
- CNZ CTYPE ;show on CRT if not in quiet mode
- INX H ;get the next location in the string
- JMP ILPRTQ1
- ;
- ILPRTQ2 XTHL ;restore the address
- RET
- ;
- PRTMSG MVI C,PRINT ;print the string
- JMP BDOS
- ;
- ; Displays error statement then resturns to command mode
- ;
- ERXIT POP D
- CALL PRTMSG
- MVI A,BELL
- CALL TYPE
- CALL CRLF
- ;
- ERXIT1 MVI A,1
- STA ABTFLG ;shows an unintentional abort
- LDA BCHFLG ;in batch mode?
- ORA A
- JNZ DONETB ;if not, exit
- JMP ABORT ;abort other computer
- ;
- ; Exits directly to CP/M, with no reboot unless you have selected pos-
- ; sible overwriting of 'CCP'
- ;
- EXIT LDA OLDUSER ;get original user number back
- MOV E,A
- CALL STUSER
- MVI C,STDMA
- LXI D,TBUF ;restore original buffer area
- CALL BDOS
- LXI B,1A00H ;a little delay timer
- ;
- EXIT1 DCX B ;one less loop to make
- MOV A,B
- ORA C
- JNZ EXIT1 ;loop again till both are zero
- CALL CKCON ;catch any extra keyboard characters
- LDA NFILFLG ;saving for a disk file?
- ORA A
- CNZ WRFIL1 ;if yes, close the file
- LDA SAVCCP ;was 'CCP' left intact?
- ORA A
- JZ 0000H ;if not, warm reboot just in case
- ;
- EXIT2 XRA A ;clear the 'A' reg. and all flags
- LHLD STACK ;get the original stack pointer back
- SPHL ;set the stack pointer to that address
- RET
- ;
- ; Catch any extra keyboard characters coming through BDOS
- ;
- CKCON MVI C,CONST ;see if any characters waiting
- CALL BDOS
- ORA A
- RZ ;if not, exit
- MVI C,RDCON ;otherwise get the character
- CALL BDOS
- XRA A ;discard the character
- JMP CKCON ;see if any others
- ;
- MOVE128 MVI B,128
- ;
- MOVE MOV A,M
- STAX D
- INX H
- INX D
- DCR B
- JNZ MOVE
- RET
- ;
- ; Sends the character in 'A' to the modem
- ;
- SNDCHR CALL SNDNOW ;wait until modem is ready for character
- MOV A,B ;get the original character back
- JMP O$MDDATP ;send the character to modem, return
- ;
- ; Initializes CP/M file control blocks AT 5CH and 6CH
- ;
- STFCB LXI D,CMDBUF
- LXI H,FCB
- JMP CMDLINE
- ;
- ; Adjusts loop counter for the selected clock speed. Returns with delay
- ; in 'HL'.
- ;
- FIXCNT LDA CLOCK ;get the user's clock speed
- PUSH D ;save the current 'DE' value
- PUSH H
- POP D ;get same value into 'DE' as in 'HL'
- ;
- CNTMUL DAD D ;add 'DE' to 'HL'
- DCR A ;one less to go
- JNZ CNTMUL
- POP D ;restore current 'DE', delay in 'HL'
- RET
- ;
- ;=======================================================================
- ;
- ; 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 maximum 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 cmd 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 cmd 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 DRIVE
- ;
- NAME1 MVI C,8 ;transfer first filename to FCB
- CALL TRANS
- CPI CR
- JZ DONEL
- CPI ' ' ;if space, then start of
- JZ NAME2 ; second filename
- POP H ;filetype must be after
- PUSH H ; eighth byte of name
- LXI B,9
- DAD B
- MVI C,3 ;transfer type of first file
- CALL TRANS
- CPI CR
- JZ DONEL
- ;
- NAME2 LDAX D ;eat multiple spaces
- CPI ' ' ; between names
- JNZ NAME3
- INX D
- JMP NAME2
- ;
- NAME3 POP H ;second name starts in 16th byte
- PUSH H ;point HL to this byte
- LXI B,16
- DAD B
- CALL DRIVE
- MVI C,8
- CALL TRANS
- CPI CR
- JZ DONEL
- POP H ;second 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 char 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
- PUSH B
- MVI M,0
- INX H
- MVI B,11
- MVI A,' '
- CALL INITFIL
- MVI B,5
- XRA A
- CALL INITFIL
- MVI B,11
- MVI A,' '
- CALL INITFIL
- MVI B,4
- XRA A
- CALL INITFIL
- POP B
- POP H
- RET
- ;
- INITFIL MOV M,A
- INX H
- DCR B
- JNZ INITFIL
- RET
- ;
- DRIVE INX D ;check 2nd byte of filename - if it
- LDAX D ; is a ":", then 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
- INX D
- ;
- DEFDR INX H ;name field in FCB
- RET
- ;
- TRANS LDAX D ;transfer from command line to FCB
- INX D ;up to number of characters specified
- CPI CR ;in '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
- ;
- 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 TSTTYP
- ;
- FILL1 CALL FILL
- ;
- TSTTYP MVI B,3 ;scan and fill type field for name
- ;
- TSTTYPL MOV A,M ; specified above
- CPI '*'
- JZ FILL2
- INX H
- DCR B
- JNZ TSTTYPL
- RET
- ;
- FILL2 CALL FILL
- RET
- ;
- FILL MVI M,'?' ;routine transfers '?'
- INX H
- DCR B
- JNZ FILL
- RET
- ;
- ;=======================================================================
- ; LISTS DIRECTORY AND GIVES FREE SPACE REMAINING ON THE REQUESTED DRIVE.
- ;
- ; Disk system reset - currently bypassed, if you wish this feature, put
- ; JMP DRLST2 instead of JMP DRLST3 in the eighth line. The
- ; current disk (plus the A: drive) will then reset each DIR re-
- ; quest. You can also reset the disk with the LOG command when
- ; when inserting a different one. This saves a reset each time
- ; DIR might be requested.
- ;
- DRLST CALL GETDISK
- ADI 'A' ;change to ASCII
- STA DRNAME ;show for drive name
- STA ACTDRV ;show for space remaining on drive
- ;
- DRLST1 JMP DRLST3
- ;
- DRLST2 MVI C,RESET ;13 reset disk system (RESETDK)
- CALL BDOS
- ;
- ; Directory list routine
- ;
- DRLST3 LXI D,CMDBUF ;put command line in FCB
- LXI H,FCB ; addressed by HL-reg
- CALL CMDLINE ; and then
- LXI H,FCB4
- CALL INITFCB
- LDA FCB2 ;get drive number
- STA FCB4
- LDA FCB2+1
- CPI ' ' ;if a space (blank) get all names
- PUSH PSW
- CZ QSTMARK
- POP PSW
- CNZ MOVNAME ;else move name into FCB
- CALL DRIVEL
- MVI C,STDMA
- LXI D,TBUF
- CALL BDOS
- LDA NOFCOL ;number of columns into 'A' reg.
- STA NAMECT ;CRLF after 'NOFCOL' number of columns
- LXI D,FCB4
- MVI C,SRCHF ;do first search
- CALL BDOS
- INR A ;0FFH --> 0 if no file(s) found
- JNZ DIRLOOP
- CALL ILPRT
- DB '++ FILE NOT FOUND ++',0
- JMP STORAGE ;still show storage on default drive
- ;
- DIRLOOP CALL GETADD
- INX H ;point to first letter of filename
- LXI D,PRTNAME
- LXI B,8
- CALL MOVER
- INX D
- LXI B,3
- CALL MOVER
- CALL ILPRT
- ;
- PRTNAME DB ' ','.',' ',0 ; 8 spaces, period, 3 spaces
- ;
- NEXTSR LXI D,FCB4
- MVI C,SRCHN ;do next search
- CALL BDOS
- INR A ;if 0FFH --> 0 then
- JZ STORAGE ; directory-read finished
- PUSH PSW
- PUSH D
- PUSH H
- LDA NAMECT
- DCR A
- STA NAMECT ;name count updated
- ORA A
- CZ CRLF ;terminate line of file names
- JNZ FENCE
- LDA NOFCOL ;restart columns-per-line count
- STA NAMECT
- JMP NOFENCE ;fence not needed
- ;
- FENCE CALL ILPRT
- DB ' : ',0 ;fence if not at end of line or
- ; ; LAST FILENAME
- NOFENCE POP H
- POP D
- POP PSW
- JMP DIRLOOP
- ;
- ; Determine storage remaining on default drive
- ;
- STORAGE CALL CKCPM3
- MVI C,DSKPAR ;current disk parameter block
- CALL BDOS
- INX H
- INX H
- MOV A,M ;get block shift factor
- STA BSHIFTF
- INX H ;bump to block mask
- MOV A,M ;get it
- STA BMASK
- INX H
- INX H
- MOV E,M ;get max block number
- INX H
- MOV D,M
- XCHG
- SHLD BMAX ;put it away
- MVI C,DSKALL ;address of cp/m allocation vector
- CALL BDOS
- XCHG ;get its length
- LHLD BMAX
- INX H
- LXI B,0 ;initialize block count to zero
- ;
- GSPBYT PUSH D ;save allocation 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
- 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 count
- INX D ; of allocation vector
- JMP GSPBYT ;process it
- ;
- ENDALC POP D ;clear alloc vector pointer from stack
- MOV L,C ;copy block to HL
- MOV H,B
- LDA BSHIFTF ;get block shift factor
- SUI 3 ;convert from records to thousands (k)
- JZ PRTFREE ;skip shifts if 1k blocks
- ;
- FREKLP DAD H ;multiply blocks by k per block
- DCR A
- JNZ FREKLP
- ;
- PRTFREE CALL DECOUT ;(# of free k bytes now in 'HL')
- LXI D,FREEMSG
- JMP PRTMSG
- ;
- ; Subroutines for 'DRLST' section
- ;
- QSTMARK MVI A,'?' ;if blank in FCB, put in 11 '?' chars.
- MVI B,11
- LXI H,FCB4+1
- ;
- QSTLP MOV M,A
- INX H
- DCR B
- JNZ QSTLP
- RET
- ;
- MOVNAME LXI H,FCB2+1
- LXI D,FCB4+1
- LXI B,11
- CALL MOVER
- RET
- ;
- GETADD DCR A ;un-do the INR above
- ADD A ;times 32
- ADD A
- ADD A
- ADD A
- ADD A
- ADI TBUF ;add buffer offset
- MOV L,A
- MVI H,0
- RET
- ;
- DRIVEL LDA FCB4 ;if no drive, use
- ORA A ; default drive in DRNAME
- JZ PRNTHD
- PUSH PSW
- DCR A
- MOV E,A
- MVI C,SELDSK
- CALL BDOS
- POP PSW
- ADI 40H ;make 1=A, 2=B, etc., and
- STA DRNAME ; overwrite default stored below
- STA ACTDRV
- ;
- PRNTHD CALL ILPRT
- DB 'Drive '
- ;
- DRNAME DB ' :',CR,LF,0
- RET
- ;
- ; Initialized storage
- ;
- FREEMSG DB 'k bytes free on drive '
- ACTDRV DB ' :',CR,LF,'$'
- ;
- ; Uninitialized storage
- ;
- BMAX DS 2 ;highest block number on drive
- BMASK DS 1 ;rec/blk - 1
- BSHIFTF DS 1 ;number of shifts to multiply by rec/blk
- ;
- ;=======================================================================
- ;
- ; Duplicates 'READ BUFFER' routine same as CP/M function 10, but does
- ; not use CTL-C (reason for the routine). Does allow controls U, R, E
- ; and H (BACKSPACE). Outputs bell if the input is greater than the
- ; buffer.
- ;
- INBUF PUSH PSW
- PUSH H
- PUSH B
- PUSH D ;'DE' registers must be pushed last
- ;
- INBUFA CALL CLRBUF ;clear the buffer area
- POP D ;get address of buffer on retries
- PUSH D ;restore stack
- XRA A
- INX D ;address count field
- STAX D ;initialize with a zero in count byte
- INX D
- XCHG ;address first buffer byte with 'HL'
- ;
- INBUFB CALL KEYIN ;(waits for char)
- CALL UCASE ;convert to upper case if needed
- CPI CR ;is it <return> (enter command)?
- JZ INBUFR ;if so, then return.
- CPI 08H ;CTL-H backspaces over deleted character
- JZ DELETE
- CPI 7FH ;is it a delete?
- JZ DELETE
- CPI 'U'-40H ;is it a CTL-U?
- JZ INBUFO ;output #, CR, LF, and start over
- CPI 'R'-40H ;CTL-R retypes line
- JZ RETYPE
- ;
- INBUFC MOV B,A ;save inputted character
- XCHG ;save 'HL' in 'DE'
- POP H ;get address of buffer in 'HL'
- PUSH H ;restore stack
- INX H ;address count byte
- INR M ;increase count byte
- DCX H ;address maximum
- MOV A,M ;put maximum in 'A'
- INX H ;address count
- CMP M ;compare count to maximum
- JC ALERTL ;if maximum, ring bell and wait for cr.
- XCHG ;restore buffer pointer to 'HL'
- MOV M,B ;put inputted character in buffer
- MOV A,B ;output it
- CPI EXITCHR ;exit character?
- JZ INBUFR ;if yes, all done
- CPI 20H ;printing character?
- CNC TYPE ;if yes, print it
- INX H ;bump pointer
- JMP INBUFB ;get next character
- ;
- DELETE XCHG ;save buffer pointer in 'DE'
- POP H ;address beginning of buffer
- PUSH H ;restore stack
- INX H ;address count field
- MOV A,M
- SUI 1 ;decrease count
- MOV M,A
- JC NODEL ;don't delete past beginning of buffer
- XCHG ;restore buffer pointer to 'HL'
- DCX H ;point to last byte inputted
- MOV A,M ;get the character being deleted
- MVI M,' ' ;restore blank
- CPI ' ' ;see if a non-printing character
- JC INBUFB ;if yes, skip the CRT backup
- MVI A,BKSP
- CALL TYPE ;true erase if 08H
- MVI A,' '
- CALL TYPE
- MVI A,BKSP
- CALL TYPE
- JMP INBUFB
- ;
- MORE DB '12345' ;5 bytes extra from DELETE routine fix
- ;
- NODEL INR M ;do not leave count negative
- XCHG ;restore pointer to 'HL'
- MVI A,BELL ;says can go no further
- CALL TYPE
- JMP INBUFB
- ;
- INBUFO MVI A,'#' ;announces the line has been removed
- CALL TYPE
- CALL CRLF
- JMP INBUFA
- ;
- RETYPE POP D
- PUSH D
- INX D ;point to current number of characters
- LDAX D
- MOV B,A
- MVI A,'#'
- CALL TYPE
- CALL CRLF
- MOV A,B ;test if zero input
- ORA A
- JZ INBUFB
- ;
- CTLRLP INX D
- LDAX D
- CALL TYPE
- DCR B
- JNZ CTLRLP
- JMP INBUFB
- ;
- ALERTL MVI A,BELL ;alarm for full buffer
- CALL TYPE
- DCR M
- XCHG
- JMP INBUFB
- ;
- PCRLF CALL CRLF
- JMP INBUFB
- ;
- INBUFR CALL CRLF ;1st new line after a command character
- POP D
- POP B
- POP H
- POP PSW
- RET
- ;
- CLRBUF POP D ;accounts for call
- POP H ;restore the registers
- PUSH H
- PUSH D
- MOV B,M ;save maximum in 'B'
- INX H ;point to first buffer byte
- INX H
- MVI A,' '
- ;
- CLEARL MOV M,A
- INX H
- DCR B
- JNZ CLEARL
- RET
- ;
- ;=======================================================================
- ;
- ; In-line compare. Compares string addressed by 'DE' to string after
- ; call (ends with zero). Return with carry set means strings not the
- ; same. All registers except 'A'-reg are unaffected.
- ;
- INLNCP XTHL ;point 'HL' to 1st character
- PUSH D
- ;
- ILCOMPL MOV A,M ;'HL' points to in-line string
- ORA A ;end of string if zero
- JZ SAME
- LDAX D
- CMP M
- JNZ NOTSAME
- INX H
- INX D
- JMP ILCOMPL
- ;
- NOTSAME XRA A ;if not same, finish through
- ;
- NSLP INX H ; string so return will
- CMP M ; go to instruction after
- JNZ NSLP ; string and not remainder of string
- STC
- ;
- SAME POP D
- INX H ;avoids a NOP instruction
- XTHL ; when returning
- RET
- ;
- ;=======================================================================
- ; MULTI-FILE ACCESS ROUTINE
- ;
- ; 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 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
- 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 MVI A,2
- INR A
- JPE MFNAM4
- DB 0EDH,0B0H ;Z-80 'LDIR' instruction
- RET
- ;
- 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
- ;
- ;=======================================================================
- ; CALCULATE FILE TRANSFER TIME
- ; Shows the time to transfer a file at various baud rates. (110-19200)
- ;
- SNDTM CALL ILPRT
- DB 'File open: ',0
- LHLD RCNT ;get record count
- CALL DECOUT ;print decimal number of records
- ;
- LDA HEXSHO
- ORA A
- JZ SNDTM1
- CALL ILPRT
- DB ' (',0
- CALL DHXOUT ;now print size in hex
- CALL ILPRT
- DB 'H)',0
- ;
- SNDTM1 CALL ILPRT
- DB ' records'
- DB CR,LF,'Send time: ',0
- LDA MSPEED ;get the speed indicator
- MVI D,0
- MOV E,A ;set up for table access
- LXI H,BTABLE ;point to baud factor table
- DAD D ;index to proper factor
- DAD D ;factor in 'DE'
- MOV E,M
- INX H
- MOV D,M
- LHLD RCNT ;get # of records
- CALL DVHLDE ;divide HL by value in DE (records/min)
- PUSH H
- MOV L,C
- MOV H,B
- CALL DECOUT ;print the minutes portion
- CALL ILPRT
- DB ' mins, ',0
- LXI H,RECDBL ;point to divisors for seconds
- LXI D,0 ; calculation
- LDA MSPEED ;get index for baud rate
- MOV E,A
- DAD D ;index into table
- MOV A,M ;get multiplier
- POP H ;get remainder
- CALL MULHLA ;multiply the 'HL' x 'A'
- CALL SHFTHL
- CALL SHFTHL
- CALL SHFTHL
- CALL SHFTHL
- MVI H,0
- CALL DECOUT ;print the seconds portion
- CALL ILPRT
- DB ' secs at ',0
- CALL PRTBAUD
- CALL ILPRTQ
- DB 'To cancel: use CTL-X',CR,LF,0
- RET
- ;
- BTABLE DW 5,13,20,26,29,48,85,152,280,480,0 ;records/min for..
- RECDBL DB 192,74,48,37,33,20,11,6,3,2,0 ;110-19200 baud
- ;
- ; Shows baud rates set for 'time to send' file transfer
- ;
- PRTBAUD LXI H,BAUDSPD
- MVI D,0
- LDA MSPEED ;get baud rate code
- MOV E,A ;x1
- ADD A ;x2
- ADD A ;x4
- ADD E ;x5
- ADD E
- MOV E,A
- DAD D ;point to correct rate
- XCHG
- MVI C,PRINT
- CALL BDOS
- CALL ILPRT
- DB ' bps ',CR,LF,0
- RET
- ;
- BAUDSPD DB '110$',0,0,'300$',0,0,'450$',0,0,'600$',0,0,'710$',0,0
- DB '1200$',0,'2400$',0,'4800$',0,'9600$',0,'19200$'
- ;
- ;----> DVHLDE: Divides 'HL' by value in 'DE',
- ; Upon exit: 'BC'=quotient,'L'=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 dividend
- INX B ;bump quotient
- JC DIVL1 ;loop till sign changes
- DCX B ;adjust quotient
- POP D ;retrieve divisor
- DAD D ;adjust remainder
- RET
- ;
- ;----> MULHLA: Multiply the value in 'HL' by the value in 'A'
- ; Return with answer in 'HL'
- ;
- MULHLA XCHG ;multiplicand to 'DE'
- LXI H,0 ;init product
- INR A ;adjust multiplier for zero test
- ;
- MULLP DCR A
- RZ
- DAD D
- JMP MULLP
- ;
- ; Shift 'HL' register pair one bit to the right
- ;
- SHFTHL MOV A,L
- RAR
- MOV L,A
- ORA A ;clear the carry
- MOV A,H
- RAR
- MOV H,A
- RNC
- MVI A,128
- ORA L
- MOV L,A
- RET
- ;
- ;=======================================================================
- ; CRC SUBROUTINES
- ;
- ; Check 'CRC' bytes of record just received
- ;
- CRCCHK PUSH H
- LHLD CRCVAL
- MOV A,H
- ORA L
- POP H
- RZ
- MVI A,0FFH
- RET
- ;
- ; Generate the CRC tables for fast calculations
- ;
- CRCGN LXI H,CRCTBL ;address at start of 'CRC' lookup table
- MVI C,0
- ;
- CRCGN1 XCHG ;store table location into 'DE'
- LXI H,0 ;clear 'HL' pair
- MOV A,C
- PUSH B
- MVI B,8
- XRA H
- MOV H,A
- ;
- CRCGN2 DAD H ;index into the table
- JNC CRCGN3
- MVI A,16 ;using x^ 16 + x^12 + x^5 + 1 algorithm
- XRA H ;(called 'SDLC' networking algorithm)
- MOV H,A
- MVI A,32+1
- XRA L
- MOV L,A
- ;
- CRCGN3 DCR B
- JNZ CRCGN2 ;make 8 loops, one for each bit
- ;
- ; Value now in 'HL', table address still stored in 'DE'. Exchange, and
- ; store the 'CRC' value in the two tables after splitting.
- ;
- POP B ;finished borrowing the 'B' register
- XCHG ;address back in 'HL', 'CRC' in 'DE'
- MOV M,D ;store 1st part of 'CRC' value
- INR H ;move up 256 bytes
- MOV M,E ;store 2nd part of 'CRC' value
- DCR H ;move back 256 bytes
- INX H ;increment to next location
- INR C ;done when 'C' reg. turns zero again
- JNZ CRCGN1 ;now go do the next location
- RET
- ;
- ; Update the CRC value from a character in the 'A' register
- ;
- CRCUPD PUSH PSW ;save all registers just in case
- PUSH B
- PUSH D
- PUSH H
- LHLD CRCVAL ;get current value
- XCHG ;put in 'DE' for now
- MVI B,0
- XRA D
- MOV C,A ;now have the character in 'BC' pair
- LXI H,CRCTBL ;start of 'CRC' lookup-table
- DAD B ;index into the 'CRC' table
- MOV A,M ;get the value from the table
- XRA E
- MOV D,A
- INR H ;move 256 bytes for 2nd table location
- MOV E,M ;put value there into 'E' register
- XCHG ;put 'DE' into 'HL'
- SHLD CRCVAL ;updated 'CRC' value with this character
- POP H ;restore all registers
- POP D
- POP B
- POP PSW
- RET
- ;
- ;=========================START OF MENU ================================
- ;
- MENU0 LDA NFILFLG
- ORA A
- JZ MENU ;exit if not saving memory for disk file
- CALL ILPRT ;else print message
- DB CR,LF,'** File still open, use DEL, DIR, WRT, E, L '
- DB 'or T ** ',CR,LF,BELL,0
- JMP MENU1
- ;
- MENU XRA A
- STA ABTFLG ;null the flag
- ;
- MENU1 LXI H,RESTSN ;restore record numbers for new file
- LXI D,RECNOB ; transfer
- MVI B,RECNOE-RECNOB
- CALL MOVE
- LXI H,RSTOPT ;restore option table
- LXI D,OPTBL
- MVI B,OPTBE-OPTBL
- CALL MOVE
- XRA A
- STA FSTFLG
- STA TIMFLG
- STA FLTRFLG ;reset multi-file trans
- STA MFFLG1
- JMP XPRT
- ;
- ; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- ; MENU OF COMMANDS
- ; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
- ;
- MENU2 CALL CLRTST
- CALL ILPRT
- DB ' Single Letter Commands',CR,LF,LF
- DB ' ? - Display current settings',CR,LF
- MENU3 DB ' ^ - Function key intercept character, '
- DB 'then (0-9)',CR,LF
- DB ' M - Display the menu',CR,LF
- DB ' E - Terminal mode with echo',CR,LF
- DB ' L - Terminal mode with local echo',CR,LF
- DB ' T - Terminal mode',CR,LF
- DB ' For copying text to disk use T (E or L) '
- DB 'FILENAME.TYP',CR,LF
- DB ' Start or Stop toggles described on subsequent'
- DB ' screen.',CR,LF
- DB ' R - Receive CP/M file using Christensen Protocol'
- DB CR,LF
- DB ' S - Send CP/M file using Christensen Protocol',CR,LF
- DB ' COMMAND: R (or S) FILENAME.TYP',CR,LF
- DB ' R and S can use the following subcommands:'
- DB CR,LF
- DB ' B - Bulk transfer using wildcards '
- DB '(e.g., *.*)',CR,LF
- DB ' D - Disconnect when done'
- DB CR,LF
- DB ' Q - Quiet mode (no messages to console)'
- DB CR,LF
- DB ' V - View <R> or <S> bytes on console'
- DB CR,LF
- DB ' X - When done, disconnect, go to CP/M'
- DB CR,LF,LF
- DB ' The single letter commands may also be used on '
- DB 'the',CR,LF
- DB ' command line when the program is initially '
- DB 'executed.',CR,LF,LF,0
- ;
- THRLTR CALL J$NXTSCR
- CALL ILPRT
- DB ' Three Letter Commands',CR,LF,LF
- DB 'CPM - Exit from this program to CP/M',CR,LF
- DB 'DIR - List directory and space free (may specify '
- DB 'drive)',CR,LF
- DB 'ERA - Erase file (may specify drive)',CR,LF
- DB 'LOG - Change default drive/user no. (specify '
- DB 'drive/user)',CR,LF
- DB ' and reset disks. e.g. LOG A0: or LOG B: '
- DB '(user # unchanged)',CR,LF
- DB 'SPD - Set file output speed in terminal mode'
- DB CR,LF,0
- ;
- CALL SORPTST
- JNZ NOTIME
- CALL ILPRT
- DB 'TIM - Select Baud rate for "time-to-send" msg.',CR,LF,0
- ;
- NOTIME LDA TGLECRC
- ORA A
- JZ NOTOCRC
- CALL ILPRT
- DB 'TCC - Toggle CRC/Checksum mode on receive',CR,LF,0
- ;
- NOTOCRC LDA TGLELOC
- ORA A
- JZ NTOGOC
- CALL ILPRT
- DB 'TLC - Toggle local command immediate or after ',0
- LDA EXTCHR
- CALL SHFTYPE
- DB CR,LF,0
- ;
- NTOGOC LDA TGLELF
- ORA A
- JZ NTOGUB
- CALL ILPRT
- DB 'TLF - Toggle LF after CR in "L" or "T" mode for '
- DB 'a disk file',CR,LF,0
- ;
- NTOGUB LDA TGLERUB
- ORA A
- JZ NTOGF
- CALL ILPRT
- DB 'TRB - Toggle rubout to backspace conversion',CR,LF,0
- ;
- NTOGF LDA TGXOFF
- ORA A
- JZ NTOGOF
- CALL ILPRT
- DB 'TXO - Toggle XOFF testing in terminal mode '
- DB 'file output',CR,LF,0
- ;
- NTOGOF LDA PMMIMD ;using a PMMI modem?
- ORA A
- JNZ NONUM
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JNZ NTOG2
- ;
- NTOG1 CALL ILPRT
- DB 'NUM - List remote systems',CR,LF,0
- ;
- NTOG2 LDA STUPTST
- ORA A
- JZ NONUM
- CALL ILPRT
- DB 'SET - Set modem baud rate',CR,LF,0
- ;
- NONUM CALL ILPRT
- DB 'BYE - Disconnect, then return to CP/M'
- DB CR,LF,0
- LDA PMMIMD ;using a PMMI modem?
- ORA A
- JNZ NONUM0 ;if yes, display 'CAL'
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ NOPMMI ;exit if neither
- ;
- NONUM0 CALL ILPRT
- DB 'CAL - Dial number',CR,LF,0
- ;
- NOPMMI CALL ILPRT
- DB 'DSC - Disconnect from the phone line',CR,LF,LF
- DB ' The following are terminal text '
- DB 'buffer commands:',CR,LF,LF,0
- ;
- SKPLF CALL ILPRT
- DB 'DEL - Delete memory buffer and file',CR,LF
- DB 'WRT - Write memory buffer to disk file',CR,LF,LF,0
- CALL NXTSCR
- CALL ILPRT
- DB ' Local Commands while in Terminal Mode'
- DB CR,LF,LF,0
- LDA BRKCHR
- CALL SHFTYPE
- DB ' - Send a break tone for 300 ms.',CR,LF,0
- LDA PMMIMD
- ORA A
- JZ SKPLF1
- LDA CHGBAUD
- CALL SHFTYPE
- DB ' - Change baud rate',CR,LF,0
- ;
- SKPLF1 MVI A,EXITCHR
- CALL SHFTYPE
- DB ' - Exit to command mode',CR,LF,0
- LDA TRANLOG
- ORA A
- JZ NOTLOG
- LDA LOGCHR
- CALL SHFTYPE
- DB ' - Send log-on message',CR,LF,0
- ;
- NOTLOG LDA NOCONCT
- CALL SHFTYPE
- DB ' - Disconnect from the phone line',CR,LF,0
- LDA LSTTST
- ORA A
- JZ NOLIS
- LDA LSTCHR
- CALL SHFTYPE
- DB ' - Toggle printer',CR,LF,0
- ;
- NOLIS MVI A,LF
- CALL TYPE
- LDA SAVECHR
- CALL SHFTYPE
- DB ' - Start copy into buffer',CR,LF,0
- LDA UNSAVCH
- CALL SHFTYPE
- DB ' - Stop copy into buffer',CR,LF,LF
- DB ' Start & Stop may be toggled as often as '
- DB 'desired.',CR,LF
- DB ' A ";" at start of line indicates buffer '
- DB 'is copying.',CR,LF
- DB ' XOFF automatically used to stop input '
- DB 'when writing',CR,LF
- DB ' full buffer to disk, XON sent to '
- DB 'resume.',CR,LF,LF,0
- LDA TRANCHR
- CALL SHFTYPE
- DB ' - Transfer ASCII file to remote',CR,LF,LF,0
- LDA LOCNXT
- ORA A
- LDA EXTCHR
- JNZ REMDFLT
- CALL SHFTYPE
- DB ' - Send local control character to remote'
- DB CR,LF,LF,0
- JMP CKSPCL
- ;
- REMDFLT CALL SHFTYPE
- DB ' - Next character will be used for local control'
- DB CR,LF,0
- ;
- CKSPCL CALL J$SPMEN ;may have a special menu in the overlay
- ; ;FALLS ON THROUGH TO 'XPRT'
- ;
- ;=======================================================================
- ; START OF COMMAND LINE HANDLING
- ;
- ; Check first to see if a file was opened for copying incoming to disk
- ;
- XPRT CALL CRLF ;turn up a blank line to look nice
- LDA NFILFLG ;have a file open for text mode copy?
- ORA A
- JZ XPRT1 ;if not, exit
- ;
- CALL GETSPC ;otherwise show remaining space
- CALL ILPRT
- DB ' Bytes of buffer free',CR,LF,LF,0
- ;
- ; Show disk drive and user number, then command line
- ;
- XPRT1 MVI C,CURDSK ;current disk function
- CALL BDOS
- ADI 'A' ;make ASCII
- CALL TYPE
- CALL GETUSER ;get current user number
- ORA A
- JZ XPRT2 ;skip if user 0
- MVI H,0
- MOV L,A
- CALL DECOUT ;show current user area
- ;
- XPRT2 MVI A,'>'
- CALL TYPE
- MVI A,'>'
- CALL TYPE
- CALL ILPRT
- DB 'COMMAND: ',0
- XRA A
- STA XFLG ;null the buffer-length flag
- ;
- ; Get the command line parameters
- ;
- GTCMD LXI D,CMDBUF ;enter command
- CALL INBUF
- LDA CMDBUF+2
- CPI EXITCHR ;exit character
- JZ XPRT1
- ;
- GTCMD1 CPI '^' ;function key intercept character
- JZ FUNCT ; (supplied from 'INTCPT' table)
- CPI '?'
- JZ CURPAR
- CPI ' '
- JZ XPRT+3 ;skip the extra line feed
- LDA CMDBUF+3
- CPI ':' ;see if request for new drive/user
- JZ STDRV
- LXI D,CMDBUF+2 ;point to command
- CALL INLNCP
- DB 'CPM',0
- JNC EXIT
- CALL CRLF ;(1st CR/LF at 'INBUFR')
- CALL INLNCP
- DB 'LOG',0
- JNC LOGNW
- CALL INLNCP
- DB 'DIR',0
- JNC DIR
- CALL INLNCP
- DB 'ERA',0
- JNC ERASEF
- CALL INLNCP
- DB 'SPD',0
- JNC STSPD
- CALL INLNCP
- DB 'TIM',0
- JNC STTIM
- CALL INLNCP
- DB 'TCC',0
- JNC TGCRC
- CALL INLNCP
- DB 'TRB',0
- JNC TGRUB
- CALL INLNCP
- DB 'TLC',0
- JNC TGLOC
- CALL INLNCP
- DB 'TLF',0
- JNC TGLF
- CALL INLNCP
- DB 'TXO',0
- JNC TGTXOFF
- LDA PMMIMD ;using a PMMI modem?
- ORA A
- JNZ NONUM1 ;if yes, exit
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JNZ NONUM1 ;if yes, exit
- CALL INLNCP
- DB 'NUM',0
- JNC NUMPR
- ;
- NONUM1 LDA STUPTST
- ORA A
- JZ NXOPT1
- CALL INLNCP
- DB 'SET',0
- JNC STUPENT
- ;
- NXOPT1 CALL INLNCP
- DB 'WRT',0
- JNC WRFIL
- CALL INLNCP
- DB 'DEL',0
- JNC NEWFILE
- CALL INLNCP
- DB 'BYE',0
- JNC BYEBYE
- CALL INLNCP
- DB 'DSC',0
- JNC DONETD
- LDA PMMIMD ;using a PMMI modem?
- ORA A
- JNZ NXOPT0 ;if yes, exit
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ NXOPT2 ;exit if neither modem-type
- ;
- NXOPT0 CALL INLNCP ;'DE' set from 1st 'INLNCP' call
- DB 'CAL',0
- JC NXOPT2
- MVI A,' ' ;fool the system
- STA CMDBUF+3 ; 'TBUF' so that it
- JMP DOOPT ; looks at option for dial
- ;
- NXOPT2 LDA CMDBUF+2
- LXI H,COMLST
- CALL COMPARE ;compares list pointed to by HL
- JC NOTVLD ;carry set = no match
- ;
- DOOPT CALL STFCB ;loads command buffer into FCB
- CALL PROCOPT ;check out the options
- JMP RSTRT ;go to work
- ;
- NOTVLD CALL NVLDMS
- JMP XPRT
- ;
- NVLDMS CALL ILPRT
- DB '++ Invalid command ++',CR,LF,BELL,0
- RET
- ;
- FUNCT LDA INTCPT ;get the function key intercept char.
- ANI 07FH ;strip off any parity
- PUSH PSW ;save the character for now
- CALL CLRTST
- CALL ILPRT
- DB ' SPECIAL FUNCTION KEY TABLE'
- DB CR,LF,LF,0
- POP PSW ;get the character back
- CPI ' ' ;see if a printing character
- JNC FUNCT1 ;if a printing character, show it
- PUSH PSW
- CALL ILPRT
- DB 'CTL-',0
- POP PSW
- ADI 40H ;convert binary to ASCII character
- ;
- FUNCT1 CALL TYPE ;show on the CRT
- CALL ILPRT
- DB ' current function key intercept character',CR,LF,LF,0
- ;
- ; Shows the functions of the (0-9) keys
- ;
- LXI H,FNCTBL-1 ;index into the function key table
- MVI B,10 ;has ten entries
- ;
- FUNCT2 INX H ;next table location
- MOV A,M ;get the binary function number
- ADI '0' ;convert binary to ASCII digits
- CALL TYPE
- MVI A,' '
- CALL TYPE
- ;
- FUNCT3 INX H ;next table location
- MOV A,M
- ORA A ;see if a binary zero
- JZ FUNCT5
- CPI CR
- JNZ FUNCT4
- CALL ILPRT
- DB '<CR>',0
- JMP FUNCT3
- ;
- FUNCT4 CALL TYPE
- JMP FUNCT3
- ;
- FUNCT5 CALL CRLF
- DCR B
- JNZ FUNCT2
- CALL CRLF
- JMP XPRT
- ;
- BYEBYE LDA PMMIMD ;using a PMMI modem?
- ORA A
- ;;; CNZ J$GOODBY ;if yes, disconnect
- DB 0,0,0 ;(PREVENT DOUBLE DISCONNECT)
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- CNZ SMRST ;if yes, disconnect
- CALL J$GOODBY ;user's custom-area goodbye routine
- CALL ILPRT
- DB CR,LF,'<< Exit to CP/M >>',CR,LF,0
- JMP EXIT ;return to CP/M
- ;
- SMRST MVI B,20
- CALL TIMER
- LXI H,SM$DISC
- CALL SNDOUT
- MVI B,20
- CALL TIMER
- MVI A,' '
- ;
- ; If showing the +++ and ATH and ATD, etc. move the three semicolons up
- ; one line.
- ;
- DB 0,0,0
- ;;; CALL TYPE
- LXI H,SM$ATZ
- CALL SNDOUT
- ;
- SMRST1 MVI B,2
- CALL RECV
- JNC SMRST1
- RET
- ;
- SM$ATZ DB 'ATZ',CR,'$'
- ;
- DIR MVI C,CURDSK
- CALL BDOS
- STA DISKSAV
- CALL DRLST
- LDA DISKSAV
- MOV E,A
- MVI C,SELDSK
- CALL BDOS
- JMP XPRT
- ;
- ERASEF LXI D,CMDBUF ;put cmd line into FCB at 'HL'
- LXI H,FCB
- CALL CMDLINE
- CALL MOVEFCB ;move FCB+16 to FCB
- LDA FCB+1
- CPI ' '
- JZ NOTVLD ;go if no file specified
- LXI D,FCB
- MVI C,SRCHF
- CALL BDOS
- INR A ;0 if file not found
- JNZ ERAFILE ;ok, go erase
- CALL ILPRT
- DB '++ File not found ++',CR,LF,BELL,0
- JMP XPRT
- ;
- ERAFILE LXI D,FCB
- MVI C,ERASE
- CALL BDOS
- CALL ILPRT
- DB 'File erased',CR,LF,0
- JMP XPRT
- ;
- LOGNW LDA NFILFLG ;file open for memory save to disk?
- ORA A
- JNZ NORESET ;if yes, do not reset disk drive now
- LDA CMDBUF+6 ;any disk drive specified?
- CPI ' '
- JNZ LOGNW1 ;if not a blank, exit
- CALL GETDISK ;if not, use current drive
- ADI 'A' ;to compensate for next line
- ;
- LOGNW1 SUI 'A'
- CPI 15+1 ;for drives 0-15
- JNC NOTVLD ;if more than 15, display error message
- STA DISKSAV ;store requested drive
- CALL GETUSER ;pick up current user number
- MOV B,A ;save it
- LDA CMDBUF+7 ;get new user number
- CALL CHRCK ;check the character
- CALL FNDUSR
- LDA CMDBUF+8 ;get 2nd digit
- CALL CHRCK ;check the character
- CALL FNDUSR+2
- ;
- LOGNW2 CALL SVUSER
- MVI C,RESET
- CALL BDOS
- LDA DISKSAV
- MOV E,A
- MVI C,SELDSK
- CALL BDOS
- LDA SAVUSR
- MOV E,A
- CALL STUSER
- JMP XPRT
- ;
- CHRCK CPI ' '
- JZ CHRCK1
- CPI ':' ;in case of A: or A1: or A11: (etc.)
- RNZ
- ;
- CHRCK1 POP PSW ;reset the 'CALL' on the stack
- JMP LOGNW2
- ;
- FNDUSR MVI B,0 ;zero the 'B' reg. for 1st time through
- CALL NUMCHK ;if neither, see if a valid number
- MOV C,A ;save
- MOV A,B ;get save first digit
- ADD A ;x2
- ADD A ;x4
- ADD A ;x8
- ADD B ;x9
- ADD B ;x10
- ADD C
- MOV B,A ;save
- RET
- ;
- SVUSER MOV A,B
- CPI 15+1 ;user numbers are 0-15
- JNC NOTVLD
- STA SAVUSR
- RET
- ;
- NUMGET LXI D,CMDBUF
- CALL INBUF
- LDA CMDBUF+2 ;get number
- CPI ' '
- RZ
- ;
- NUMCHK SUI '0' ;remove ascii bias
- CPI 9+1
- RC ;ok if 9 or less
- POP H ;remove 1st call from the stack
- POP H ;remove 2nd call from the stack
- JMP NOTVLD
- ;
- GETUSER MVI E,0FFH ;get current user
- ;
- STUSER MVI C,USER ;set up BDOS call
- JMP BDOS
- ;
- GETDISK MVI C,CURDSK ;get current drive
- JMP BDOS
- ;
- NORESET CALL ILPRT
- DB '++ Terminal mode file open ++',CR,LF
- DB '++ Use WRT or DEL before LOG command ++',CR,LF
- DB CR,LF,BELL,0
- XRA A
- JMP XPRT
- ;
- STSPD CALL ILPRT
- DB 'Delay between chars. (0-9): ',0
- ;
- NOKYS CALL STAT
- JZ NOKYS
- CALL KEYIN
- CALL TYPE
- CALL SAVEA
- SUI '0'
- CPI 10
- JNC NOTVLD
- STA BYTDLY
- ;
- CALL ILPRT
- DB 'Delay at end of line (0-9): ',0
- ;
- NOKYS1 CALL STAT
- JZ NOKYS1
- CALL KEYIN
- CALL TYPE
- CALL SAVEA
- SUI '0'
- CPI 10
- JNC NOTVLD
- STA CRDLY
- ;
- SPDMSG CALL ILPRT
- DB CR,LF,'Char. delay (terminal file mode) is: ',0
- LDA BYTDLY
- MOV B,A
- MOV A,B
- PUSH H
- MOV L,A
- MVI H,0
- CALL DECOUT
- POP H
- CALL ILPRT
- DB '0 ms. per character',CR,LF
- DB 'Line delay (terminal file mode) is: ',0
- LDA CRDLY
- MOV B,A
- PUSH H
- MOV L,A
- MVI H,0
- CALL DECOUT
- POP H
- CALL ILPRT
- DB '00 ms. per character',CR,LF,0
- JMP XPRT
- ;
- SAVEA PUSH PSW
- CALL ILPRT
- DB CR,LF,0
- POP PSW
- RET
- ;
- STDRV LDA CMDBUF+2 ;get the disk drive
- SUI 'A' ;convert to binary value
- CPI 15+1 ;for drives 0-15
- JNC NOTVLD
- MOV E,A
- MVI C,SELDSK ;select requested drive
- CALL BDOS
- LDA CMDBUF+5 ;get user number, if any
- CPI ' ' ;keep current user area?
- JZ XPRT
- SUI '0' ;convert to binary value
- CPI 1 ;if a '1', could be units or tens
- JNZ STDRV1 ;if not, numbers stop at 15 so exit
- LDA CMDBUF+6 ;check for a 2nd digit
- CPI '0'
- JC STDRV2 ;if less, not a valid number, ignore
- SUI '0'-10 ;leave the '10' in as two digits used
- ;
- STDRV1 CPI 15+1 ;user areas are 0-15
- JNC NOTVLD
- MOV E,A
- CALL STUSER
- JMP XPRT ;back to work
- ;
- STDRV2 MVI A,1
- JMP STDRV1
- ;
- STTIM CALL SORPTST
- JNZ NOTVLD
- CALL ILPRT
- DB 'Use 0-8 to give baud rate for ''S'' mode '
- DB 'time-to-send message,',CR,LF
- DB 'where 0=110, 1=300, 2=450, 3=600, 4=710, 5=1200, '
- DB '6=2400, ',CR,LF,'7=4800 8=9600 and 9=19200 Baud.'
- DB CR,LF,LF,'Enter value: ',0
- CALL NUMGET
- CPI 9+1 ;only looking for 0-9 answers
- JNC NOTVLD
- STA MSPEED
- CALL STTIM1
- JMP XPRT
- ;
- STTIM1 CALL SORPTST
- JNZ STTIM2
- CALL ILPRT
- DB 'Rate for the S mode time-to-send message is set to ',0
- JMP STTIM3
- ;
- STTIM2 CALL ILPRT
- DB 'Modem speed is ',0
- ;
- STTIM3 JMP PRTBAUD
- ;
- SORPTST LDA STUPTST ;if setup is 'YES' or PMMIMD is
- MOV B,A ; 'YES' or autodial modem is 'YES'
- LDA PMMIMD ; return with zero bit not set
- ORA B
- RNZ
- LDA AUTDIAL
- ORA B
- RET
- ;
- TGCRC LDA TGLECRC ;allowing CRC/CHECKSUM toggle?
- ORA A
- JZ NOTVLD ;if not, exit
- LDA CRCDFLT ;get present value and switch it
- CMA
- STA CRCDFLT
- CALL TGCRC1 ;show on CRT it has been changed
- JMP XPRT
- ;
- TGCRC1 CALL ILPRT
- DB 'Mode: ',0
- LDA CRCDFLT ;see if set for 'CRC' or 'CHECKSUM'
- ORA A
- JZ CHEKMSG
- CALL ILPRT
- DB 'CRC',CR,LF,0
- RET
- ;
- CHEKMSG CALL ILPRT
- DB 'CHECKSUM',CR,LF,0
- RET
- ;
- TGRUB LDA TGLERUB
- ORA A
- JZ NOTVLD
- LDA CONVRUB
- CMA
- STA CONVRUB
- CALL TGRUB1
- JMP XPRT
- ;
- TGRUB1 LDA CONVRUB
- ORA A
- JZ NORUBMS
- CALL ILPRT
- DB 'Rub is backspace',CR,LF,0
- RET
- ;
- NORUBMS CALL ILPRT
- DB 'Rub is rub',CR,LF,0
- RET
- ;
- TGLOC LDA TGLELOC
- ORA A
- JZ NOTVLD
- LDA LOCNXT
- CMA
- STA LOCNXT
- CALL TGLOC1
- JMP XPRT
- ;
- TGLOC1 CALL ILPRT
- DB 'Use ',0
- LDA LOCNXT
- ORA A
- LDA EXTCHR
- JZ LOCMSG
- CALL SHFTYPE
- DB ' before local command',CR,LF,0
- RET
- ;
- LOCMSG CALL SHFTYPE
- DB ' to send local command to remote',CR,LF,0
- RET
- ;
- TGLF LDA TGLELF
- ORA A
- JZ NOTVLD
- LDA ADDLFD
- CMA
- STA ADDLFD
- CALL TGLF1
- JMP XPRT
- ;
- TGLF1 CALL ILPRT
- DB 'LF ',0
- LDA ADDLFD ;adding LF after CR?
- ORA A
- JNZ LFMSG ;if yes, exit
- CALL ILPRT
- DB 'NOT ',0
- ;
- LFMSG CALL ILPRT
- DB 'sent after CR in "L" or "T" for a disk file',CR,LF,0
- RET
- ;
- TGTXOFF LDA TGXOFF
- ORA A
- JZ NOTVLD
- CALL ILPRT
- DB 'Use XOFF testing? (Y/N): ',0
- CALL GETANS
- JC NOCHG3
- STA XOFFTST
- ;
- NOCHG3 CALL XOFFMSG
- CALL ILPRT
- DB CR,LF,'Use XON waiting after <CR> (Y/N): ',0
- CALL GETANS
- JC NOCHG4
- STA XONWAIT
- ;
- NOCHG4 CALL XONMS
- LDA XONWAIT
- ORA A
- JZ XPRT
- CMA
- STA XOFFTST ;do not allow both
- CALL ILPRT
- DB 'Therefore ',0
- CALL XOFFMSG
- JMP XPRT
- ;
- GETANS LXI D,CMDBUF
- CALL INBUF
- LDA CMDBUF+2 ;get answer
- CPI ' '
- CMC ;set the carry flag
- RZ
- MOV B,A
- CPI 'N'
- MVI A,0
- RZ
- MOV A,B
- CPI 'Y'
- MVI A,1
- RZ
- POP PSW ;preserve stack
- JMP NOTVLD
- ;
- XOFFMSG CALL ILPRT
- DB 'XOFF testing ',0
- LDA XOFFTST
- ORA A
- JNZ XOTSTON
- CALL ILPRT
- DB 'NOT ',0
- ;
- XOTSTON CALL ILPRT
- DB 'used',0
- ;
- XONMS1 CALL ILPRT
- DB ' in terminal mode file output',CR,LF,0
- RET
- ;
- XONMS CALL ILPRT
- DB 'XON ',0
- LDA XONWAIT
- ORA A
- JNZ XONMS2
- CALL ILPRT
- DB 'NOT ',0
- ;
- XONMS2 CALL ILPRT
- DB 'automatically tested after CR',0
- JMP XONMS1
- ;
- STUPENT LDA STUPTST
- ORA A
- JZ NOTVLD
- LXI D,CMDBUF+1
- CALL J$STUPR
- LDA AUTDIAL ;using a Hayes-type modem?
- ORA A
- JZ XPRT ;if not, exit, otherwise
- MVI B,'A' ; send 'AT',CR to autodial modem
- CALL SNDCHR ; to insure its baud rate
- MVI B,'T' ; matches that just selected
- CALL SNDCHR
- MVI B,CR
- CALL SNDCHR
- JMP XPRT
- ;
- NEWFILE LDA NFILFLG ;file open for disk save?
- ORA A
- JZ NFILOP ;if not, show "no file open" message
- LDA FCB3+1 ;check that file was requested
- CPI ' '
- JZ NFILOP ;if no file, do not erase
- LXI D,FCB3 ;otherwise erase the old file
- MVI C,ERASE
- CALL BDOS
- XRA A
- STA NFILFLG ;no file mentioned, reset flags
- STA SAVEFLG
- LXI H,FCB3
- CALL INITFCB
- LXI H,BUFFER ;reset flags to bottom of ram just
- SHLD HLSAV ; to insure they are there
- JMP XPRT
- ;
- WRFIL LDA NFILFLG ;saving memory for a disk file?
- ORA A
- JZ NFILOP ;not saving a file, don't bother writing
- CALL WRFIL1 ;close the file
- STA SAVEFLG
- STA WRFLG
- LXI H,FCB3
- CALL INITFCB ;blank out 'FCB' to written file
- LXI H,BUFFER ;can not be erased
- SHLD HLSAV ;reset to buffer start for next time
- JMP XPRT
- ;
- WRFIL1 LDA FCB3+1 ;check that file was requested
- CPI ' '
- RZ
- CALL WRDSK ;write buffer to disk if not empty
- ;
- WRFIL2 LXI D,FCB3 ;close the file
- MVI C,CLOSE
- CALL BDOS
- XRA A
- STA NFILFLG ;file written, reset flags
- RET
- ;
- NFILOP CALL ILPRT
- DB '++ No File Open ++',CR,LF,BELL,0
- JMP XPRT
- ;
- ; THIS ROUTINE DISPLAYS THE PHONE NUMBERS IN THE LIBRARY
- ;
- NUMPR PUSH H
- CALL CLRTST
- CALL ILPRT
- DB ' Library of Phone Numbers of Remote Systems'
- DB 0
- MVI C,18 ;number of lines to move
- LXI H,NUMLIB ;address of source memory
- LXI D,BUFFER ;address of target memory
- CALL NEWLINE ;start with CRLF
- STAX D ;+LF
- INX D ;and bump it
- ;
- NUMPR1 INX H ;skip PMMI dialing letter
- INX H ;and equal sign
- MVI B,LIBLEN-2 ;number of bytes to move
- CALL MOVE ;move to buffer
- CALL SPACES ;2 entries + 3 spaces = 63 characters
- PUSH H ;save source address
- PUSH D ;save destination address
- INX H ;skip next two characters
- INX H
- LXI D,(17*LIBLEN) ;get offset of 17 times entry length
- DAD D ;add it to the source address
- POP D ;restore destination address
- MVI B,LIBLEN-2 ;get length of library entry
- CALL MOVE ;move another entry
- POP H ;restore source address
- CALL NEWLINE ;start next line
- DCR C ;one less line to print
- JNZ NUMPR1 ;if not finished, do another
- MVI A,'$'
- STAX D
- MVI C,PRINT
- LXI D,BUFFER ;point to table of numbers to print
- CALL BDOS
- CALL CRLF
- CALL CRLF
- POP H
- JMP XPRT ;finished, back to prompt
- ;
- NEWLINE MVI A,CR ;puts CRLF at memory pointed by 'DE'
- STAX D ;store it
- MVI A,LF ;line feed
- INX D ;bump pointer
- STAX D ;store lf
- INX D ;bump pointer
- RET
- ;
- SPACES MVI A,' ' ;space
- STAX D
- INX D ;1
- STAX D
- INX D ;2
- STAX D
- INX D ;3
- RET
- ;
- COMPARE MOV B,M ;compares 'A' register with list
- ;
- COMPLP INX H ;addressed by HL - first element
- CMP M ;of list must be number of elements
- JZ VALID ;being compared. returns with
- DCR B ;carry set if 'A' reg. does not
- JNZ COMPLP ;contain an element in list
- STC
- ;
- VALID RET
- ;
- NXTSCR CALL ILPRT
- DB 'HIT any KEY to CONTINUE',0
- ;
- NOKEY1 CALL STAT ;get keyboard status
- JZ NOKEY1 ;keep looping until keypress
- CALL KEYIN ;gobble up keypress
- CPI 'C'-40H ;control-c to abort?
- JNZ CLRTST
- POP H ;clear stack of return address
- CALL CRLF ;turn up a blank line
- JMP XPRT
- ;
- CLRTST LDA SCRNTST
- ORA A
- JNZ CLRSCR
- ;
- LOTSALF MVI A,CR
- CALL TYPE
- MVI B,12
- MVI A,LF
- ;
- LFLOOP CALL TYPE
- DCR B
- JNZ LFLOOP
- RET
- ;
- CURPAR CALL CLRTST
- CALL ILPRT
- DB ' Current Settings',CR,LF,LF,0
- CALL TGCRC1
- CALL TGRUB1
- LDA LSTTST
- ORA A
- JZ NOLIS1
- CALL LSTMS
- ;
- NOLIS1 CALL STTIM1
- CALL ILPRT
- DB 'Terminal mode file buffer is ',0
- LDA NFILFLG ;saving memory for a disk file?
- ORA A
- JNZ ACTIVE ;if yes, go say "active"
- CALL ILPRT
- DB 'in',0 ;if not, say "inactive"
- ;
- ACTIVE CALL ILPRT
- DB 'active',CR,LF,'Unused portion of buffer is ',0
- CALL GETSPC
- CALL ILPRT
- DB ' bytes',CR,LF,0
- CALL TGLOC1
- CALL TGLF1
- CALL XOFFMSG
- CALL XONMS
- CALL SPDMSG
- CALL CRLF
- CALL CRLF
- CALL CRLF
- JMP XPRT
- ;
- GETSPC LXI D,BUFTOP ;top of memory buffer
- LHLD HLSAV ;current buffer location
- XCHG
- XRA A ;clear the carry bit, if set
- SUB E
- MOV L,A
- MOV A,H
- SBB D
- MOV H,A
- CALL DECOUT ;print the space remaining
- RET
- ;
- ;***********************************************************************
- ; DATA AREA
- ;***********************************************************************
- ;
- COMLST DB 6,'S','R','T','E','L','M'
- ;
- ; OPTION TABLE
- ;
- OPTBL EQU $
- ANSWFLG DB 'A'
- BCHFLG DB 'B'
- DISCFLG DB 'D'
- JMPCMD DB 'J'
- LOCLFG DB 'L'
- ORIGFLG DB 'O'
- QFLG DB 'Q'
- RSEEFLG DB 'R'
- SSEEFLG DB 'S'
- VSEEFLG DB 'V'
- XITFLG DB 'X'
- EPRITY DB '0' ;even parity sub-option (only in S or R mode)
- OPRITY DB '1' ;odd parity sub-option (only in S or R mode)
- OPTBE EQU $ ;transfer when program initially called.
- ;
- ; The following must be in the same order as the table above
- ;
- RSTOPT DB 'A','B','D','J','L','O','Q','R','S','V','X','0','1'
- ;
- ; The next 14 bytes equal the number of bytes between RECNOB and
- ; RECNOE.
- ;
- RESTSN DB 0,0,0,0,0,0
- DW BUFFER
- DB 0,0,0,0,0,NAK
- ;
- RECNOB EQU $ ;start of table marker
- RCVRNO DB 0 ;\
- RECNO DB 0,0 ; \
- ERRCT DB 0 ; \
- ERRCDE DB 0 ; \
- EOFLG DB 0 ; \ 14 bytes between table markers
- RECPTR DW BUFFER ; /
- RECINBF DB 0 ; /
- MAXEXT DB 0 ; /
- RCNT DB 0,0 ; /
- DATAFLG DB 0 ;/
- BENHERE DB NAK ;
- RECNOE EQU $ ;end of table marker
- ;
- ; Additional 16-bit initialized storage
- ;
- CRCVAL DW 0
- DIALCT DW 0
- HLSAV DW BUFFER
- HLSAV1 DW PBUFF
- HLSAV2 DW PBUFF
- ;
- ; Additional general purpose initialized storage
- ;
- ABTFLG DB 0
- ACKFLG DB 0
- CRCFLAG DB 0
- CRFLAG DB 0
- CURRENT DB 52 ;PMMI 300 baud speed value
- DLYFLG DB 0 ; (defaults to 300)
- ECHOFLG DB 0
- EXACFLG DB 0
- FIRSTME DB 0
- FNKFLG DB 0 ;function key activity flag
- FSTFLG DB 0
- LISTFLG DB 0
- LOCFLG DB 0
- MFFLG1 DB 0
- MDCTLB DB 07FH
- NFILFLG DB 0
- ONERR DB 0
- OPTION DB 0
- ORIGSAV DB 0
- RNGBKFL DB 0
- SAVEFLG DB 0
- UARTCT DB ORIGMOD ;for originate mode
- WRFLG DB 0
- XFLG DB 0
- CMDBUF DB 80H,0 ;command buffer control area
- ;
- ; General purpose unitialized storage area
- ;
- DS 128 ;storage area for 'CMDBUF'
- BGNMS DS 2
- TIMFLG DS 1
- FLTRFLG DS 1
- CHRFLG DS 1
- TIMVAL DS 2
- QUIKTIM DS 2
- DISKNO DS 1
- DISKSAV DS 1
- DSTORE DS 1
- FILECT DS 1
- FTYCNT DS 1
- MAXRAM DS 1
- NAMECT DS 1
- NBSAVE DS 2
- OLDUSER DS 1
- SNDFLG DS 1
- SAVUSR DS 1
- ;
- FCB3 DS 33
- FCB4 DS 33
- FCBBUF DS 15
- MFNAM5 DS 12
- MFNAM6 DS 12 ;current name
- DS 100 ;minimum stack depth
- ;
- EVNPAGE EQU ($+255)/256*256 ;sets buffers on even page
- ;
- ORG EVNPAGE
- ;
- STACK EQU EVNPAGE-2 ;store original stack pointer
- CRCTBL DS 512 ;two tables of 128 bytes each
- BUFFDSK DS 128 ;buffer for disk save
- BUFFPNT DS 128 ;buffer for printer
- BUFFER DS 1024*BUFSIZ ;send/receive file buffer
- BUFTOP DS 0 ;filled in when length is found
- PBUFF EQU $ ;printer buffer starts here
- NAMEBUF EQU $ ;batch-mode filenames buffer
- ;
- ; BDOS EQUATES
- ;
- RDCON EQU 1
- WRCON EQU 2
- LIST EQU 5
- PRINT EQU 9
- RDBUF EQU 10
- CONST EQU 11
- CPMVER EQU 12
- RESET EQU 13
- SELDSK EQU 14
- OPEN EQU 15
- CLOSE EQU 16
- SRCHF EQU 17
- SRCHN EQU 18
- ERASE EQU 19
- READ EQU 20
- WRITE EQU 21
- MAKE EQU 22
- REN EQU 23
- CURDSK EQU 25
- STDMA EQU 26
- DSKALL EQU 27
- DSKPAR EQU 31
- USER EQU 32
- FILSIZ EQU 35
- BDOS EQU 0005H
- REIPL EQU 0
- FCB EQU 5CH
- FCBEXT EQU FCB+12
- FCBSNO EQU FCB+32
- FCBRNO EQU FCB+32
- FCB2 EQU 6CH
- TBUF EQU 80H
- ;
- END