home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpm
/
modem7
/
modm700.aqm
/
MODM700.ASM
Wrap
Assembly Source File
|
1985-02-09
|
154KB
|
6,498 lines
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