home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug047.ark
/
MODEM7.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
48KB
|
2,589 lines
; CP/M MODEM PROGRAM
;THE FOLLOWING IS AN EXTENSIVE REVISION OF THE CP/M MODEM PROGRAM
;CREATED BY WARD CHRISTENSEN FOR THE CP/M USERS LIBRARY.
;IT ALSO INCORPORATES ROUTINES FOUND IN THE POTOMAC MICRO-MAGIC MODEM
;MANUAL WHICH MAY BE USED IF YOU HAVE A PMMI MODEM BOARD.
;THE ADDITIONAL ROUTINES ARE COPYRIGHTED (1980) BY:
;Mark M. Zeiger and James K. Mills
;198-01B 67th Ave. 824 Jordan Place
;Flushing, N.Y. 11365 Rockford, IL 61108
;(212) 454-6985 (815) 398-0579
;Permission is grant pmmi auto-dial function, 255 MAX.
CHGBAUD EQU 'B'-40H ;USED IN TERMINAL MODE TO CHANGE
;BAUD RATE 'ON THE FLY'
ERRLIM EQU 10 ;NUMBER OF TIMES TO RETRY
;SEND/RECEIVE ERRORS BEFORE QUIT
EXITCHR EQU 'E'-40H ; ^E = EXIT WITHOUT DISCONNECT
DISCCHR EQU 'D'-40H ; ^D = DISCONNECT
TRANCHR EQU 'T'-40H ; ^T = TRANSFER CHARACTER
CAN EQU 'X'-40H ; ^X = CANCEL SEND/RECEIVE
EOFCHAR EQU 'Z'-40H ; ^Z = END OF FILE
SAVECHR EQU 'Y'-40H ; ^Y = SAVE CHARACTER
XOFF EQU 'S'-40H ; ^S = XOFF CHARACTER
XON ES
PORT EQU 0E0H ;PMMI BASE ADDRESS
MODCTLP EQU PORT ;MODEM CONTROL PORT
MODSNDB EQU 1 ;MODEM SEND BIT (XMIT BUFF EMPTY)
MODSNDR EQU 1 ;MODEM SEND READY
MODRCVB EQU 2 ;MODEM RECEIVE BIT (DAV)
MODRCVR EQU 2 ;MODEM RECEIVE READY
MODDATP EQU PORT+1 ;MODEM DATA PORT
BAUDRP EQU PORT+2 ;BAUD RATE PORT
MODCTL2 EQU PORT+3 ;2ND MODEM CONTROL PORT
ORIGMOD EQU 1DH ;ORIGINATE MODE
ANSWMOD EQU 1EH ;ANSWER MODE
WAITCTS EQU 255 ;number of seconds X 10 to wait for computer
;tone afterING
;THE PROGRAM.
PMMIBYTE DB TRUE ;true=pmmi modem
IMSAIBYTE DB FALSE ;true=imsai front panel
FASTCLK DB FALSE ;4 MHz or greater
BAKUPBYTE DB TRUE ;true=make .BAK file
XPRFLG DB TRUE ;true=no menu, false=print menu
PULSERATE DB 125 ;125 FOR 20PPS, 250 FOR 10PPS dialing
IN$MODCTLP IN MODCTLP ! RET ;in modem control port
OUT$MODDATP OUT MODDATP ! RET ;out modem data port
ANI$MODSNDB ANI MODSNDB ! RET ;bit to test for send ready
CPI$MODSNDR CPI MODSNDR ! RET ;value of send bit when rEQU 'Q'-40H ; ^Q = XON CHARACTER
SOH EQU 1 ; START OF HEADER
EOT EQU 4 ; END OF TEXT
ACK EQU 6 ; ACKNOWLEDGE
NAK EQU 15H ; NOT ACKNOWLEDGE
BDNMCH EQU 75H ; BAD NAME MATCH
OKNMCH EQU ACK ; OKAY NAME MATCH
LF EQU 10 ; LINEFEED
CR EQU 13 ; CARRIAGE RETURN
BELL EQU 7 ; BELL CHARACTER
FRONTPAN EQU 0FFH ; IMSAI FRONT PANEL
BOTTRAM SET LAST+100H AND 0FF00H
ORG 100H
JMP START
;THESE ROUTINES ARE AT THE BEGINNING OF THE PROGRAM SO
;THEY CAN BE PATCHED BY A MONITER WITHOUT RE-ASSEMBLRY TABLE FOR DIALING FROM LIBRARY
; OF NUMBERS STORED IN THESE DB'S AT ASSEMBLY-TIME.
; EACH DB MUST BE 30 CHARACTERS LONG FOR PROPER OPERATION.
; A 'DB 0' INDICATES NO DIALING, PROGRAM WILL DISCONNECT
; AND RETURN TO COMMAND MODE. LAST DB MUST BE DB 0. UP TO
; 26 NUMBERS ARE ALLOWED.
; '----5---10---15---20---25---30'
NUMBLIB DB 'A=Atlanta CBBS 1-404-394-4220' ;'A'
DB 'B=Chicago CBBS 1-312-545-8086' ;'B'
DB 'C=Calamity Clif 1-312-234-9257' ;'C'
DB 'D=Detroit CP/M* 1-313-588-7054' ;'D'
eady
IN$MODDATP IN MODDATP ! RET ;in modem data port
ANI$MODRCVB ANI MODRCVB ! RET ;bit to test for receive ready
CPI$MODRCVR CPI MODRCVR ! RET ;value of receive bit when ready
JMP$INITMOD JMP INITMOD ;to initialize port, if necessary
OUT$MODCTLP OUT MODCTLP ! RET ;out modem control port
IN$BAUDRP IN BAUDRP ! RET ;in baudrate port
OUT$BAUDRP OUT BAUDRP ! RET ;out baudrate port
OUT$MODCTL2 OUT MODCTL2 ! RET ;out modem control port #2
CRFLAG DB 0 ;CONTINUOUS REDIAL FLAG
; PHONE NUMBER LIBRA'
DB 'Q= ' ;'Q'
DB 'R= ' ;'R'
DB 'S=SOURCE/Rockford 398-6090' ;'S'
DB 'T= ' ;'T'
DB 'U= ' ;'U'
DB 'V= ' ;'V'
DB 'W= ' ;'W'
DB 'X= ' ;'X'
DB 'Y= ' ;'Y'
DB 'Z= ' ;'Z'
DB 0 ; end
START LXI H,0
DAD SP ;GET CP/M'S STACK
SHLD STACK ;SAVEed to use, but not to sell, these routines.
;LAST REVISION 12/18/80 -- changed disconnect timing
MACLIB MODEM ;CONTAINS CMDLINE, INBUF, INLNCOMP,
;DIR, AND MFACCESS ROUTINES
;changed to MODEM.LIB by Jim Mills
;to differentiate from other 'MACROS.LIB'
; minor revision 10/26/80 to allow 25-second 'wait' after pmmi
; autodial -- longer time required for Chicago CBBS*. Jim Mills.
; * CBBS is a trademark of Ward Christensen and Randy Suess.
TRUE EQU 0FFH
FALSE EQU 0
; PMMI EQUAT'
DB 'Q= ' ;'Q'
DB 'R= ' ;'R'
DB 'S=SOURCE/Rockford 398-6090' ;'S'
DB 'T= ' ;'T'
DB 'U= ' ;'U'
DB 'V= ' ;'V'
DB 'W= ' ;'W'
DB 'X= ' ;'X'
DB 'Y= ' ;'Y'
DB 'Z= ' ;'Z'
DB 0 ; end
START LXI H,0
DAD SP ;GET CP/M'S STACK
SHLD STACK ;SAVE IT
LXI SP,STACK ;START LOCAL STACK
CALL START1
DB CR,LF,'MODEM7 as of 12/18/80',cr,lf
DB 'Originally Written by Ward Christensen',cr,lf
DB 'Revisions by Mark M. Zeiger, Jim Mills',cr,lf,'$'
START1 POP D ;GET ADDRESS OF ABOVE MESSAGE
MVI C,PRINT ; 9
CALL BDOS
CALL INITADR ;INITIALIZE ADDRESSES
MVI A,TRUE ; 0FFH
STA NFILFLG
CMA ; 0
STA SAVEFLG
OUT FRONTPAN ; IMSAI
CALL PROCOPT ;PROCESS CONTROL OPTIONS
LDA OPTION ;GET MAIN OPTION
CPI 'X' ;EXPERT FLAG?
JNZ RESTART ;NO
MVI A,TRUE ;YES
STA XPRFLG ;MAKE EXPERT
JMP MENU
RESTART
LDA OPTION ;GET MAIN OPTION
MOV B,A ;SAVE IT
LDA PMMIBYTE ;PMMI?
ORA A ;SET FLAGS
MOV A,B ;GET OPTION BACK
JZ S1 ;NOT PMMI
CPI 'C' ;CALL (DIAL) FUNCTION?
JZ DIALPL ;YES, GO TO IT
S1 CPI ' ' ;NO OPTION SPEC'D?
JZ MENU ;TRUE, GO MENU
CPI 'M' ;MENU ASKED FOR?
JZ MENU ;YES, GO MENU
CALL JMP$INITMOD ;
CALL MOVEFCB
MVI A,FALSE
STA NFILFLG
CALL IN$MODDATP ;GOBBLE UP GARBAGE..
CALL IN$MODDATP ;..CHARACTERS ON LINE
LDA OPTION ;PROCESS MAIN OPTION
CPI 'E' ;ECHO MODE?
JZ TRMECHO ;YES
CPI 'T' ;TERMINAL MODE?
JZ DSKSAVE ;YES
CPI 'S' ;SEND A FILE?
JZ SENDFIL ;YES
CPI 'R' ;RECEIVE A FILE?
JZ RCVFIL ;YES
CPI 'D' ;DISCONNECT?
JZ DISCON1 ;YES, DISCONNECT & GO MENU
JMP MENU ;NO OPTION SPEC'D, GO MENU
;REVISED TERMINAL ROUTINE ALLOWING MEMORY SAVE
DSKSAVE LDA NFILFLG ;NEW FILE FLAG
CPI TRUE ;OFFH? (TRUE=NORMAL TERMINAL MODE)
JZ TERM ;YES
LDA FCB+1 ;FIRST CHAR OF FILENAME
CPI ' ' ;FILE SPEC'D
JNZ GOODNM ;YES, GOOD NAME
MVI A,TRUE ;0FFH
STA NFILFLG ;
CMA ; 0
STA SAVEFLG ;
OUT FRONTPAN ;0FFH PORT FOR IMSAI FRONT PANEL
JMP TERM ;
GOODNM CALL ERASFIL
CALL MOVE2
LXI D,FCB3
MVI C,MAKE
CALL BDOS
LXI D,FCB3
MVI C,OPEN
CALL BDOS
LXI H,BOTTRAM
SHLD HLSAVE
MVI A,FALSE
STA NFILFLG
TERM CALL STAT ;KEYPRESS?
JZ TERML ;NO, CHECK LINE
CALL KEYIN ;GET CHAR FROM KBD
CPI EXITCHR ;^E?
JZ MENU ;YES, RETURN TO MENU
CPI DISCCHR ;^D?
JZ DISCON1 ;YES, DISCONNECT & RETURN TO MENU
CPI TRANCHR ;TEST FOR TRANSFER REQUEST (^T)
CZ TRANSFER ;SEND-A-FILE (BLIND SEND)
JZ TERM ;LOOP
MOV B,A
LDA PMMIBYTE
ORA A
MOV A,B
JZ S2
CPI CHGBAUD
PUSH PSW
PUSH H
CZ NEWBAUD
POP H
POP PSW
CPI CHGBAUD ;^B?
JZ TERML
S2 CPI SAVECHR
JNZ NOTOG
LDA NFILFLG ;DO NOT ALLOW SAVE IF..
CPI TRUE ;..THIS FLAG IS SET.
JZ TERML
LDA SAVEFLG
CMA
STA SAVEFLG
JMP TERML
NOTOG CALL OUT$MODDATP
TERML CALL IN$MODCTLP
CALL ANI$MODRCVB
CALL CPI$MODRCVR
JNZ TERM
CALL IN$MODDATP
CPI 0 ;CHECK FOR NULLS
JZ TERM ;DON'T PROCESS THEM
ANI 7FH ;STRIP PARITY
CALL TYPE
PUSH PSW
LDA SAVEFLG
CPI FALSE
JZ NOSAVE
POP PSW
MOV M,A
INX H
SHLD HLSAVE ;MENU COMMAND DESTROYS HL-REG..
;..GET HL WHEN ENTERING VIA 'RET' CMD.
MOV B,A
LDA IMSAIBYTE
ORA A
MOV A,B
JZ COLON
CMA ;FRONT PANEL SHOWS CHARS WHEN..
OUT FRONTPAN ;..MEMORY SAVE IS ACTIVE.
JMP NOCOLON
COLON CPI LF ;IF NO FRONT PANEL, THEN..
JNZ NOCOLON ;..TYPE ":" AFTER EACH LINE FEED..
MVI A,':' ;..WHEN MEMORY SAVE ACTIVE.
CALL TYPE
NOCOLON LDA 7 ;CHECK TO SEE IF..
DCR A ;..PAGE BELOW BDOS HAS BEEN..
CMP H ;..REACHED AND DISKSAVE IS NEEDED.
CZ INTDSKSV
JMP TERM
NOSAVE POP PSW
JMP TERM
SAVEFLG DB FALSE
LASTBYT1 DB 0
LASTBYT2 DB 0
INTDSKSV
MVI A,XOFF ;SEND A CTRL-S TO STOP..
CALL OUT$MODDATP ;..REMOTE COMPUTER OUTPUT.
MVI D,0 ;D IS THE BUFFER COUNT
CALL INMODEM ;GET LAST BYTES SENT..
STA LASTBYT1 ;..AFTER CTRL-S.
CALL INMODEM ;ADD MORE CALLS TO INMODEM..
STA LASTBYT2 ;..AND STA LASTBYT# IF YOU ARE..
;..LOSING BYTES WHEN MEMORY IS FULL.
PUSH D
CALL NUMREC1
CALL WRTDSK ;WRITE THE RECORDS
POP D
LXI H,BOTTRAM
INR D
DCR D ;TEST BUFFER COUNT FOR ZERO
JZ CTRLQ
LDA LASTBYT1 ;GET THE LAST BYTES THAT WERE..
MOV M,A ;..SAVED AND PUT THEM IN..
INX H ;..BOTTRAM.
CALL TYPE
DCR D
JZ CTRLQ
LDA LASTBYT2
MOV M,A
INX H
CALL TYPE
CTRLQ MVI A,XON ;SEND START CHARACTER..
CALL OUT$MODDATP ;..TO REMOTE COMPUTER.
RET
;THIS SUBROUTINE WILL LOOP UNTIL THE MODEM RECEIVES A CHARACTER
;OR 100 MILLISECONDS. IF A CHARACTER IS RECEIVED, A FLAG IS SET
;TO STORE THE CHARACTER. A MAXIMUM OF TWO CHARACTERS ARE STORED,
;BUT MORE MAY BE STORED IF DESIRED (SEE COMMENT IN "INTDSKSV"
;ABOVE).
INMODEM LDA FASTCLK
ORA A
JZ SLOW
LXI B,2500
JMP TIMERL
SLOW LXI B,1250
TIMERL CALL IN$MODCTLP
CALL ANI$MODRCVB
CALL CPI$MODRCVR
JZ GETBYTE
DCX B
MOV A,B
ORA C
JNZ TIMERL
RET
GETBYTE CALL IN$MODDATP
INR D
RET
NUMRECS MVI M,EOFCHAR
INX H
LXI D,127
DAD D
NUMREC1 LXI D,-(BOTTRAM)
DAD D
MOV A,L ;DIVIDE HL BY 128..
ORA A
RAL ;..TO GET THE..
MOV L,H ;..NUMBER OF SECTORS
MVI H,0
PUSH PSW
DAD H
POP PSW
MVI A,0
ADC L
MOV L,A ;RETURNS WITH NUMBER OF..
RET ;..128 BYTE RECORDS IN HL.
WRTDSK LXI D,BOTTRAM
NEXTWRT MVI C,STDMA
CALL BDOSRT
PUSH D
LXI D,FCB3
MVI C,WRITE
CALL BDOSRT
POP D
XCHG
PUSH D
LXI D,128
DAD D
POP D
XCHG
DCX H
MOV A,H
ORA L
JNZ NEXTWRT
RET
CLOSE3 LXI D,FCB3
MVI C,CLOSE
CALL BDOS
RET
BDOSRT PUSH B ! PUSH D ! PUSH H ! PUSH PSW
CALL BDOS
POP PSW ! POP H ! POP D ! POP B
RET
MOVE2 LXI H,FCB3
CALL INITFCBS
LXI H,FCB
LXI D,FCB3
MVI B,12
CALL MOVE
RET
;FILE TRANSFER ROUTINE - CALLED WITH
;CONTROL-T FROM TERMINAL ROUTINE.
;TRANSFER MAY BE CANCELLED WHILE SENDING BY USING CONTROL-X.
TRANSFER
PUSH H ! PUSH D ! PUSH B ! PUSH PSW
LXI H,FCB4
CALL INITFCBS ;INITIALIZES FCBS POINTED..
LXI H,FCB+16 ;..TO BY HL REG.
CALL INITFCBS
GET CALL GETNAME
LDA CMDBUF+2 ;WAS FILE ENTERED
CPI 20H
JZ TRANSL2
CALL MOVE4
CALL OPEN4
CPI 0FFH ;RETURN WITH 0FFH MEANS
JNZ CONTIN ;FILE DOES NOT EXIST
TRANSL1 CALL ILPRT
DB CR,LF,'++FILE DOES NOT EXIST++',CR,LF,0
TRANSL2 CALL ILPRT
DB 'TYPE "R" TO RETURN TO MODEM',CR,LF
DB 'TYPE "A" TO RE-ENTER NAME: ',BELL,0
CALL KEYIN
CALL UCASE
CALL TYPE ;ECHO RESPONSE
CALL CRLF
CPI 'A'
JZ GET
CPI 'R'
JZ RETURN
JMP TRANSL2
CONTIN LXI D,80H
MVI C,STDMA
CALL BDOS
READMR CALL READ80
CPI 1 ;END OF FILE
JZ RETURNS
CPI 2 ;BAD READ
JZ RETURNU
CALL SEND80C
CPI EOFCHAR ;END OF FILE - OMIT IF OBJECT..
JZ RETURNS ;..CODE IS TO BE SENT.
CPI CAN ;CANCELLATION?
JZ TRANCAN
JMP READMR
RETURNS CALL ILPRT
DB CR,LF,'++FILE TRANSFER COMPLETED++',CR,LF,BELL,0
JMP RETURN
RETURNU CALL ILPRT
DB CR,LF,'++FILE TRANSFER UNSUCCESSFUL++',CR,LF,BELL,0
JMP RETURN
TRANCAN CALL ILPRT
DB CR,LF,CR,LF,'++ TRANSFER CANCELLED ++',CR,LF,BELL,0
RETURN POP PSW ! POP B ! POP D ! POP H
RET
INITFCBS ;ENTRY AT +2 WILL LEAVE..
MVI M,0 ;..DRIVE NO. INTACT.
INX H ;WILL INITIALIZE AN FCB..
MVI B,11 ;..POINTED TO BY HL-REG. FILLS 1ST POS
LOOP10 MVI M,' ' ;..WITH 0, NEXT 11 WITH..
INX H ;..WITH BLANKS, AND LAST..
DCR B ;..21 WITH NULLS.
JNZ LOOP10
MVI B,21
LOOP11 MVI M,0
INX H
DCR B
JNZ LOOP11
RET
GETNAME CALL ILPRT
DB CR,LF,'ENTER FILE NAME TO BE TRANSFERRED - C/R TO QUIT: ',0
LXI D,CMDBUF
CALL INBUFF
CALL CRLF
RET
MOVE4 LXI D,CMDBUF
LXI H,FCB4
CALL CPMLINE
RET
OPEN4 LXI D,FCB4
MVI C,OPEN
CALL BDOS
RET
READ80 LXI D,FCB4
MVI C,READ
CALL BDOS
RET
SEND80C MVI B,80H
LXI H,80H
SENDCH1 MOV A,M
CALL MODOUT
CPI EOFCHAR
RZ
CALL STAT ;TEST TO SEE IF
ORA A ;CANCELLATION REQUESTED
JZ SKIP12
CALL KEYIN
CPI CAN
RZ
SKIP12 INX H
DCR B
JNZ SENDCH1
RET
MODOUT PUSH PSW
MODOUTL CALL IN$MODCTLP
CALL ANI$MODSNDB
CALL CPI$MODSNDR
JNZ MODOUTL
POP PSW
CALL OUT$MODDATP
CALL TYPE
RET
FCB4 DS 33
;TERMINAL ECHO MODE
TRMECHO CALL IN$MODCTLP
CALL ANI$MODRCVB
CALL CPI$MODRCVR
JZ LINECHR
CALL STAT
JZ TRMECHO
CALL KEYIN
CPI EXITCHR
JZ MENU
MOV B,A
LDA PMMIBYTE
ORA A
MOV A,B
JZ S3
CPI CHGBAUD ;SAME ROUTINE AS IN TERMINAL MODE
PUSH PSW
CZ NEWBAUD
POP PSW
CPI CHGBAUD
JZ TRMECHO
S3 CALL OUT$MODDATP
CALL TYPE
JMP TRMECHO
LINECHR CALL IN$MODDATP
CALL OUT$MODDATP
CALL TYPE
JMP TRMECHO
;UNCOMMENTED LINES ARE THOSE OF ORIGINAL MODEM PROGRAM.
;COMMENTS DENOTE MY ADDITIONS.
; SEND A CP/M FILE
SENDFIL LDA BATCHFLG ;CHECK IF MULTIPLE FILE..
ORA A ;..MODE IS SET.
JNZ SENDC1
MVI A,TRUE ;INDICATE BATCH SEND
STA SENDFLG
LDA FSTFLG ;IF FIRST TIME THRU..
ORA A ;..SCAN THE COMMAND LINE..
CNZ TNMBUF ;..FOR MULTIPLE NAMES.
CALL SENDFN ;SENDS FILE NAME TO RECEIVER
JNC SENDC2 ;CARRY SET MEANS NO MORE FILES.
MVI A,'B' ;STOP BATCH..
STA BATCHFLG ;..MODE OPTION.
MVI A,EOT ;FINAL XFER END
CALL SEND
JMP DONE
SENDC1 LDA FCB+1
CPI ' '
JZ BLKFILE
SENDC2 CALL OPENFIL
MVI E,80
CALL WAITNAK
SENDLP CALL RDSECT
JC SENDEOF
CALL INCRSNO
XRA A
STA ERRCT
SENDRPT CALL SENDHDR
CALL SENDSEC
CALL SENDCKS
CALL GETACK
JC SENDRPT
JMP SENDLP
SENDEOF MVI A,EOT
CALL SEND
CALL GETACK
JC SENDEOF
JMP DONE
; RECEIVE A FILE
RCVFIL LDA BATCHFLG ;CHECK IF MULT..
ORA A ;..FILE MODE.
JNZ RCVC1
MVI A,FALSE ;FLAG WHERE TO RETURN..
STA SENDFLG ;..FOR NEXT FILE TRANS.
CALL GETFN ;GET THE FILE NAME.
JNC RCVC2 ;CARRY SET MEANS NO MORE FILES.
MVI A,'B' ;STOP BATCH..
STA BATCHFLG ;..MODE OPTION.
JMP DONE
RCVC1 LDA FCB+1 ;MAKE SURE FILE IS NAMED
CPI ' '
JZ BLKFILE
JMP RCVC3
RCVC2 CALL CKCPM2
CALL CKBAKUP
RCVC3 CALL ERASFIL
CALL MAKEFIL
LDA QFLG
ORA A
JNZ RCVLP
LDA BATCHFLG
ORA A ;DON'T PRINT MSSG IF..
JZ RCVLP ;..IN MULTI AND QUIET.
CALL ILPRT
DB 'FILE OPEN, READY TO RECEIVE',CR,LF,0
RCVLP CALL RCVSECT
JC RCVEOT
CALL WRSECT
CALL INCRSNO
CALL SENDACK
JMP RCVLP
RCVEOT CALL WRBLOCK
CALL SENDACK
CALL CLOSFIL
JMP DONE
;SUBROUTINES
SENDFN LDA QFLG
ORA A
JZ SWNAK
CALL ILPRT
DB 'AWAITING NAME NAK',CR,LF,0
SWNAK MVI E,80
CALL WAITNLP
MVI A,ACK ;GOT NAK, SEND ACK
CALL SEND
LXI H,FILECT
DCR M
JM NOMRNM
LHLD NBSAVE ;GET FILE NAME..
LXI D,FCB ;..IN FCB
MVI B,12
CALL MOVE
SHLD NBSAVE
CALL SENDNM ;SEND IT
ORA A ;CLEAR CARRY
RET
NOMRNM MVI A,EOT
CALL SEND
STC
RET
SENDNM PUSH H
SENDNM1 MVI D,11 ;COUNT CHARS IN NAME
MVI C,0 ;INIT CHECKSUM
LXI H,FCB+1 ;ADDRESS NAME
NAMLPS MOV A,M ;SEND NAME
ANI 7FH ;STRIP HIGH ORDER BIT SO CP/M 2..
CALL SEND ;..WON'T SEND R/O FILE DESIGNATION.
LDA QFLG ;SHOW NAME IF..
ORA A ;..QFLG NOT SET.
MOV A,M
CNZ TYPE
ACKLP PUSH B ;SAVE CKSUM
MVI B,1 ;WAIT FOR RECEIVER..
CALL RECV ;..TO ACKNOWLEDGE..
POP B ;..GETTING LETTER.
JC SCKSER
CPI ACK
JNZ ACKLP
INX H ;NEXT CHAR
DCR D
JNZ NAMLPS
MVI A,EOFCHAR ;TELL RECEIVER END OF NAME
CALL SEND
LDA QFLG
ORA A
CNZ CRLF
MOV D,C ;SAVE CHECKSUM
MVI B,1
CALL RECV ;GET CHECKSUM..
CMP D ;..FROM RECEIVER.
JZ NAMEOK
SCKSER MVI A,BDNMCH ;BAD NAME-TELL RECEIVER
CALL SEND
LDA QFLG
ORA A
JZ SKCSER1
CALL ILPRT
DB 'CHECKSUM ERROR',CR,LF,0
SKCSER1 MVI E,80 ;DO HANDSHAKING OVER
CALL WAITNLP ;DON'T PRINT "AWAITING NAK" MSG
MVI A,ACK
CALL SEND
JMP SENDNM1
NAMEOK MVI A,OKNMCH ;GOOD NAME-TELL RECEIVER
CALL SEND
POP H
RET
GETFN LXI H,FCB
CALL INITFCBS+2 ;DOES NOT INITIALIZE DRIVE
LDA QFLG
ORA A
JZ GNAMELP
CALL ILPRT
DB 'AWAITING FILE NAME',CR,LF,0
GNAMELP CALL HSNAK
JC GNAMELP
CALL GETNM ;GET THE NAME
CPI EOT ;IF EOT, THEN NO MORE FILES
JZ NOMRNMG
ORA A ;CLEAR CARRY
RET
NOMRNMG STC
RET
GETNM PUSH H
GETNM1 MVI C,0 ;INIT CHECKSUM
LXI H,FCB+1
NAMELPG MVI B,5
CALL RECV ;GET CHAR
JNC GETNM3
LDA QFLG
ORA A
JZ GETNM2
CALL ILPRT
DB 'TIME OUT RECEIVING FILENAME',CR,LF,0
GETNM2 JMP GCKSER
GETNM3 CPI EOT ;IF EOT, THEN NO MORE FILES
JZ GNRET
CPI EOFCHAR ;GOT END OF NAME
JZ ENDNAME
MOV M,A ;PUT NAME IN FCB
LDA QFLG ;TYPE IT IF NO QFLG
ORA A
MOV A,M
CNZ TYPE
PUSH B ;SAVE CKSUM
MVI A,ACK ;ACK GETTING LETTER
CALL SEND
POP B
INX H ;GET NEXT CHAR
MOV A,L ;DON'T LET NOISE...
CPI 7FH ;..CAUSE OVERFLOW..
JZ GCKSER ;..INTO PROGRAM AREA.
JMP NAMELPG
ENDNAME LDA QFLG
ORA A
CNZ CRLF
MOV A,C ;SEND CHECKSUM
CALL SEND
MVI B,1
CALL RECV ;CHECKSUM GOOD?
CPI OKNMCH ;YES IF OKNMCH SENT..
JZ GNRET ;..ELSE DO OVER.
GCKSER LXI H,FCB ;CLEAR FCB (EXCEPT DRIVE)..
CALL INITFCBS+2 ;..SINCE IT MIGHT BE DAMAGED..
LDA QFLG ;..BY TOO MANY CHARS.
ORA A
JZ GCKSER1
CALL ILPRT
DB 'CHECKSUM ERROR',CR,LF,0
GCKSER1 CALL HSNAK ;DO HANDSHAKING OVER
JC GCKSER1
JMP GETNM1
GNRET POP H
RET
HSNAK MVI A,NAK ;SEND NAK UNTIL..
CALL SEND ;..RECEIVING ACK.
CALL CKABORT ;DON'T GET HUNG UP HERE
MVI B,2 ;WAIT 2 SECONDS..
CALL RECV ;..IN RECEIVE.
CPI CAN ;IF SENDER ABORTS..
JZ ABORT ;..DURING NAME TRANSFER.
CPI ACK ;IF NAK,RETURN WITH..
RZ ;..CARRY CLEAR.
STC
RET
TNMBUF MVI A,FALSE ;CALL FROM SENDFIL ONLY ONCE.
STA FSTFLG
STA FILECT
CALL SCAN
LXI H,NAMEBUF
SHLD NBSAVE ;SAVE ADDR OF 1ST NAME
TNLP1 CALL TRTOBUF
LXI H,FCB
LXI D,FCBBUF
CALL CPMLINE ;PARSE NAME TO CP/M FORMAT
TNLP2 CALL MFNAME ;SEARCH FOR NAMES (* FORMAT)
JC NEXTNM
LDA FCB+10 ;IF CP/M 2 $SYS FILE..
ANI 80H ;..DON'T SEND
JNZ TNLP2
LHLD NBSAVE ;GET NAME
LXI D,FCB ;MOVE IT TO FCB
XCHG
MVI B,12
CALL MOVE
XCHG
SHLD NBSAVE ;ADDR 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 65 ;NO MORE THAN 64 TRANSFERS
RC
MVI A,64 ;ONLY X'FER FIRST 64
STA FILECT
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 CMD LINE..
MOV C,M ;..AND PUT SPACE THERE.
MVI B,0
LXI H,CMDBUF+2
DAD B
MVI M,20H
LXI H,CMDBUF+1
MOV B,M
INR B
INR B
SCANLP1 INX H
DCR B
JZ DNSCAN
MOV A,M
CPI 20H
JNZ SCANLP1
SCANLP2 INX H ;EAT EXTRA SPACES
DCR B
JZ DNSCAN
MOV A,M
CPI 20H
JZ SCANLP2
SHLD BGNMS ;SAVE START OF NAMES IN CMDBUF
INR B
DCX H
SCANLP3 INX H
DCR B
JZ DNSCAN
MOV A,M
CPI 20H
JNZ SCANLP3
LDA NAMECT ;COUNTS NAMES
INR A
STA NAMECT
SCANLP4 INX H ;EAT SPACES
DCR B
JZ DNSCAN
MOV A,M
CPI 20H
JZ SCANLP4
JMP SCANLP3
DNSCAN MVI M,20H ;SPACE AFTER LAST CHAR
POP H
RET
;PLACES NEXT NAME IN BUFFER SO CPMLINE MAY PARSE IT
TRTOBUF LHLD BGNMS
MVI B,0
LXI D,FCBBUF+2
TBLP MOV A,M
CPI 20H
JZ TRBFEND
STAX D
INX H
INX D
INR B ;COUNT CHARS IN NAME
JMP TBLP
TRBFEND INX H
MOV A,M ;EAT EXTRA SPACES
CPI 20H
JZ TRBFEND
SHLD BGNMS
LXI H,FCBBUF+1 ;PUT # CHARS BEFORE NAME
MOV M,B
RET
;IN CP/M V.2, IF FILE IS R/O OR SYS, IT IS CHANGED TO 'BAK'.
CKCPM2 MVI C,12
CALL BDOS
ORA A ;RETURN 0 MEANS CP/M 1
RZ
MVI C,STDMA
LXI D,80H
CALL BDOS
MVI C,SRCHF ;SEARCH FOR FILE
LXI D,FCB
CALL BDOS
CPI 0FFH
RZ
ADD A ! ADD A ;MULT A-REG BY..
ADD A ! ADD A ;..32 TO FIND..
ADD A ;..NAME IN DMA.
LXI H,80H
ADD L
MOV L,A ;HL POINTS TO DIR NAME
LXI D,9
DAD D ;POINT TO R/O ATTRIB BYTE
MOV A,M
ANI 80H ;TEST MSB
JNZ MKCHG ;IF SET, MAKE CHANGE
INX H ;CHECK SYSTEM ATTRIB BYTE
MOV A,M
ANI 80H
RZ ;NOT $SYS OR $R/O
DCX H
MKCHG LXI D,-8
DAD D ;POINT HL TO FILENAME + 1
LXI D,FCB+1 ;MOVE DIR NAME TO FCB..
MVI B,11 ;..WITHOUT CHANGING DRIVE.
CALL MOVE
LXI H,FCB+9 ;R/O ATTRIB
MOV A,M
ANI 7FH ;STRIP R/O ATTRIB
MOV M,A
INX H ;SYS ATTRIB
MOV A,M
ANI 7FH
MOV M,A
LXI D,FCB
MVI C,30 ;SET NEW ATTRIBS IN DIR
CALL BDOS
;MAY BE CALLED BY CKBAKUP BELOW. ITS RETURN DONE HERE
PLANCHG LXI H,FCB ;CHANGE NAME TO TYPE "BAK"
LXI D,6CH
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,6CH
MVI C,ERASE ;ERASE ANY PREV BACKUPS
CALL BDOS
LXI H,6CH ;FCB2 DR FIELD SHOULD..
MVI M,0 ;..0 FOR RENAME.
LXI D,FCB
MVI C,23 ;RENAME
CALL BDOS
RET
CKBAKUP LDA BAKUPBYTE
ORA A
RZ
MVI C,SRCHF
LXI D,FCB
CALL BDOS
INR A
RZ ;FILE NOT FOUND
JMP PLANCHG ;IN "CKCPM2" - RET DONE THERE
;MULTI-FILE ACCESS SUBROUTINE FROM CP/M USER'S GROUP
;FIXED BY MARK ZEIGER 8/17/80
;CARRY IS SET IF NO MORE NAMES CAN BE FOUND
MFNAME MFACCESS ;A MACRO IN MACROS.LIB
RCVSECT XRA A
STA ERRCT
RCVRPT LDA QFLG
ORA A
JZ RCVSQ
CALL ILPRT
DB 'AWAITING #',0
LDA SECTNO
INR A
CALL HEXO
CALL CRLF
RCVSQ MVI B,7 ;10 IN ORIG PROG
CALL RECV
JC RCVSTOT
CPI CAN ;CHECK FOR CANCEL..
JZ ABORT ;..REQUEST FROM SENDER.
CPI SOH
JZ RCVSOH
ORA A
JZ RCVSQ
CPI EOT
STC
RZ
MOV B,A
LDA VSEEFLG
ORA A
JZ RCVSEH
LDA QFLG
ORA A
JZ RCVSERR
RCVSEH MOV A,B
CALL HEXO
CALL ILPRT
DB 'H RCD, NOT SOH',CR,LF,0
RCVSERR MVI B,1
CALL RECV
JNC RCVSERR
MVI A,NAK
CALL SEND
LDA ERRCT
INR A
STA ERRCT
CPI ERRLIM
JC RCVRPT
LDA VSEEFLG
ORA A
JZ RCVCKQ
LDA QFLG
ORA A
JZ RCVSABT
RCVCKQ CALL CKQUIT
JZ RCVSECT
RCVSABT CALL CLOSFIL
CALL ERXIT
DB '++ UNABLE TO RECEIVE BLOCK -- ABORTING ++',CR,LF,'$'
RCVSTOT LDA VSEEFLG
ORA A
JZ RCVSPT
LDA QFLG
ORA A
JZ RCVSERR
RCVSPT CALL ILPRT
DB '++ TIMEOUT ++ ',0
RCVPRN LDA ERRCT
CALL HEXO
CALL CRLF
JMP RCVSERR
RCVSOH MVI B,1
CALL RECV
JC RCVSTOT
MOV D,A
MVI B,1
CALL RECV
JC RCVSTOT
CMA
CMP D
JZ RCVDATA
LDA VSEEFLG
ORA A
JZ RCVBSE
LDA QFLG
ORA A
JZ RCVSERR
RCVBSE CALL ILPRT
DB '++ BAD SECTOR # IN HDR',CR,LF,0
JMP RCVSERR
RCVDATA MOV A,D
STA RCVSNO
MVI A,1
STA DATAFLG
MVI C,0
LXI H,80H
RCVCHR MVI B,1
CALL RECV
JC RCVSTOT
MOV M,A
INR L
JNZ RCVCHR
MOV D,C
XRA A
STA DATAFLG
MVI B,1
CALL RECV
JC RCVSTOT
CMP D
JNZ RCVCERR
LDA RCVSNO
MOV B,A
LDA SECTNO
CMP B
JZ RECVACK
INR A
CMP B
JNZ ABORT
RET
RCVCERR LDA VSEEFLG
ORA A
JZ RCVCPR
LDA QFLG
ORA A
JZ RCVSERR
RCVCPR CALL ILPRT
DB '++ CKSUM ++ ',0
JMP RCVPRN
RECVACK CALL SENDACK
JMP RCVSECT
SENDACK MVI A,ACK
CALL SEND
RET
SENDHDR LDA QFLG
ORA A
JZ SENDHNM
CALL ILPRT
DB 'SEND # ',0
LDA SECTNO
CALL HEXO
CALL CRLF
SENDHNM MVI A,SOH
CALL SEND
LDA SECTNO
CALL SEND
LDA SECTNO
CMA
CALL SEND
RET
SENDSEC MVI A,1
STA DATAFLG
MVI C,0
LXI H,80H
SENDC MOV A,M
CALL SEND
INR L
JNZ SENDC
XRA A
STA DATAFLG
RET
SENDCKS MOV A,C
CALL SEND
RET
GETACK MVI B,7 ;10 IN ORIG PROG
CALL RECVDG
JC GETATOT
CPI ACK
RZ
CPI CAN
JZ ABORT
MOV B,A
LDA QFLG
ORA A
JZ ACKERR
MOV A,B
CALL HEXO
CALL ILPRT
DB 'H RCD, NOT ACK',CR,LF,0
ACKERR LDA ERRCT
INR A
STA ERRCT
CPI ERRLIM
RC
LDA VSEEFLG
ORA A
JZ GACKV
LDA QFLG
ORA A
JZ CSABORT
GACKV CALL CKQUIT
STC
RZ
CSABORT CALL ERXIT
DB 'CAN''T SEND SECTOR -- ABORTING',CR,LF,'$'
GETATOT LDA QFLG
ORA A
JZ ACKERR
CALL ILPRT
DB 'TIMEOUT ON ACK',CR,LF,0
JMP ACKERR
CKABORT LDA VSEEFLG
ORA A
JZ CKABGO
LDA QFLG
ORA A
RZ
CKABGO CALL STAT
RZ
CALL KEYIN
CPI CAN
RNZ
ABORT LXI SP,STACK
ABORTL MVI B,1
CALL RECV
JNC ABORTL
MVI A,CAN
CALL SEND
ABORTW MVI B,1
CALL RECV
JNC ABORTW
MVI A,' '
CALL SEND
CALL ILPRT
DB 'ROUTINE CANCELLED',CR,LF,BELL,0
MVI A,'B' ;TURN MULTI-FILE MODE..
STA BATCHFLG ;..OFF SO ROUTINE ENDS.
JMP DONETCE
INCRSNO LDA SECTNO
INR A
STA SECTNO
RET
ERASFIL LDA BATCHFLG ;DON'T 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
CALL ILPRT
DB 'FILES EXISTS -- TYPE ''Y'' TO ERASE: ',BELL,0
CALL KEYIN
PUSH PSW
CALL TYPE
POP PSW
CALL UCASE
CPI 'Y'
JNZ MENU
CALL CRLF
NOASK LXI D,FCB
MVI C,ERASE
CALL BDOS
RET
BLKFILE CALL ILPRT ;ROUTINE IF NO FILE IS NAMED FOR "SEND" OR "RECEIVE"
DB CR,LF,'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 MAKE FILE',CR,LF
DB 'DIRECTORY MUST BE FULL',CR,LF,'$'
OPENFIL LXI D,FCB
MVI C,OPEN
CALL BDOS
INR A
JNZ OPENOK
CALL ERXIT
DB 'CAN''T OPEN FILE$'
OPENOK LDA BATCHFLG
ORA A
JNZ OPENOK1
LDA QFLG
ORA A
RZ
OPENOK1 CALL ILPRT
DB 'FILE OPEN - EXTENT LENGTH: ',0
LDA FCB+15
CALL HEXO
MVI A,'H'
CALL TYPE
CALL CRLF
RET
CLOSFIL LXI D,FCB
MVI C,CLOSE
CALL BDOS
INR A
RNZ
CALL ERXIT
DB 'CAN''T CLOSE FILE$'
RDSECT LDA SECINBF
DCR A
STA SECINBF
JM RDBLOCK
LHLD SECPTR
LXI D,80H
CALL MOVE128
SHLD SECPTR
RET
RDBLOCK LDA EOFLG
CPI 1
STC
RZ
MVI C,0
LXI D,DBUF
RDSECLP PUSH B
PUSH D
MVI C,STDMA
CALL BDOS
LXI D,FCB
MVI C,READ
CALL BDOS
POP D
POP B
ORA A
JZ RDSECOK
DCR A
JZ REOF
CALL ERXIT
DB '++ FILE READ ERROR ++$'
RDSECOK LXI H,80H
DAD D
XCHG
INR C
MOV A,C
CPI 16
JZ RDBFULL
JMP RDSECLP
REOF MVI A,1
STA EOFLG
MOV A,C
RDBFULL STA SECINBF
LXI H,DBUF
SHLD SECPTR
LXI D,80H
MVI C,STDMA
CALL BDOS
JMP RDSECT
WRSECT LHLD SECPTR
XCHG
LXI H,80H
CALL MOVE128
XCHG
SHLD SECPTR
LDA SECINBF
INR A
STA SECINBF
CPI 16
RNZ
WRBLOCK LDA SECINBF
ORA A
RZ
MOV C,A
LXI D,DBUF
DKWRLP PUSH H
PUSH D
PUSH B
MVI C,STDMA
CALL BDOS
LXI D,FCB
MVI C,WRITE
CALL BDOS
POP B
POP D
POP H
ORA A
JNZ WRERR
LXI H,80H
DAD D
XCHG
DCR C
JNZ DKWRLP
XRA A
STA SECINBF
LXI H,DBUF
SHLD SECPTR
RET
WRERR MVI C,CAN
CALL SEND
CALL ERXIT
DB 'ERROR WRITING FILE',CR,LF,'$'
RECVDG EQU $
CALL IN$MODDATP
CALL IN$MODDATP
RECV PUSH D
LDA FASTCLK
ORA A
JZ MSEC
MOV A,B
ADD A
MOV B,A
MSEC LXI D,15000 ;60% OF ORIG 50000
CALL CKABORT
MWTI CALL IN$MODCTLP
CALL ANI$MODRCVB
CALL CPI$MODRCVR
JZ MCHAR
DCR E
JNZ MWTI
DCR D
JNZ MWTI
DCR B
JNZ MSEC
POP D
STC
RET
MCHAR CALL IN$MODDATP
POP D
PUSH PSW
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
PUSH PSW
CALL SHOW
NOMONIN POP PSW
ORA A
RET
SEND 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
ADD C
MOV C,A
SENDW CALL IN$MODCTLP
CALL ANI$MODSNDB
CALL CPI$MODSNDR
JNZ SENDW
POP PSW
CALL OUT$MODDATP
RET
WAITNAK LDA VSEEFLG
ORA A
JZ WAITNPR
LDA QFLG
ORA A
JZ WAITNLP
WAITNPR CALL ILPRT
DB 'AWAITING INITIAL NAK',CR,LF,0
WAITNLP CALL CKABORT
MVI B,1
CALL RECV
CPI NAK
RZ
CPI CAN
JZ ABORT
DCR E
JZ ABORT
JMP WAITNLP
INITADR
LHLD 1
LXI D,3
DAD D
SHLD VSTAT+1
DAD D
SHLD VKEYIN+1
DAD D
SHLD VTYPE+1
LDA PMMIBYTE
ORA A
JZ JMP$INITMOD ;RETURN DONE FROM THIS ROUTINE..
LDA IN$MODCTLP+1 ;..IF NOT PMMI
STA OUT$MODCTLP+1
INR A
STA OUT$MODDATP+1
STA IN$MODDATP+1
INR A
STA IN$BAUDRP+1
STA OUT$BAUDRP+1
INR A
STA OUT$MODCTL2+1
RET
PROCOPT
LXI D,FCB+1
LDAX D
STA OPTION
OPTLP INX D
LDAX D
CPI ' '
JZ ENDOPT
LXI H,OPTBL
MVI B,OPTBE-OPTBL
OPTCK CMP M
JNZ OPTNO
MVI M,0
JMP OPTLP
OPTNO INX H
DCR B
JNZ OPTCK
JMP BADOPT
ENDOPT LDA VSEEFLG
ORA A
RNZ
STA QFLG
RET
DONE LDA BATCHFLG
ORA A
JNZ DONETCC
LDA QFLG
ORA A
JZ NMSTRNS
LXI H,FCB+1 ;PUT FILE NAME IN..
LXI D,FTRNMSG ;..SPACES IN MESSAGE..
MVI B,8 ;..BELOW.
CALL MOVE
INX D ;PUT FILE TYPE AFTER..
MVI B,3 ;..SKIPPING ONE SPACE..
CALL MOVE ;..BELOW.
CALL ILPRT
FTRNMSG DB ' TRANSFERRED',CR,LF,CR,LF,0 ;13 SPACES
NMSTRNS LDA FCB ;SAVE DRIVE NO.
STA DISKNO
LXI H,FCB ;BLANK OUT FILE CONTROL BLOCKS
CALL INITFCBS
LDA DISKNO ;PUT DRIVE NUMBER BACK
STA FCB
LXI H,RESTSN ;RESTORE SECTORE NUMBERS..
LXI D,SECTNOB ;..FOR NEW FILE TRANSFER.
MVI B,SECTNOE-SECTNOB ;ROUTINE ALSO DONE IN MENU.
CALL MOVE
LDA SENDFLG ;GOES TO EITHER SEND OR..
ORA A ;..RECEIVE FILE, DEPENDING..
JNZ SENDFIL ;..UPON WHICH ROUTINE SET..
JMP RCVFIL ;..THE FLAG IN MULTI-FILE MODE.
DONETCC MVI A,TRUE ;INDICATE NO FILES BEING..
STA FSTFLG ;RESET MULTIFILE TRANS
STA NFILFLG ;..USED IN TERMINAL ROUTINE.
CMA
OUT FRONTPAN
STA SAVEFLG ;STOP MEMORY SAVE IN TERM ROUTINE.
LDA VSEEFLG
ORA A
JZ DONETC
LDA QFLG
ORA A
JZ donetca
DONETC CALL ILPRT
DB CR,LF,'ALL TRANSFERS COMPLETED'
DB CR,LF,BELL,0
donetca lda discflg ;see if disconnect when thru
ora a
jnz donetce ;no, don't disconnect
donetcb call ilprt
db cr,lf,'++PRESS RETURN TO DISCONNECT++',bell,cr,lf,0
mvi c,rdcon
call bdos ;wait for response
cpi 0dh ;carriage return
jnz donetcb ;nope
call ilprt
db cr,lf,'++DISCONNECTED++',cr,lf,0
call disconnt ;hang-up the pmmi
jmp exit ;go to CP/M
DONETCE LDA TERMFLG ;SEE IF RETURN TO..
ORA A ;..TERMINAL MODE..
JNZ MENU ;..AFTER X'FER.
CALL CRLF
JMP TERM
INITMOD
SETBAUD LDA PMMIBYTE
ORA A
RZ
LDA ANSWFLG ;IF ANSWER OR ORIGINATE MODE..
ORA A ;..IS NOT REQUESTED OR NO..
JNZ SKIPB1 ;..BAUDRATE SPECIFIED, THEN..
CALL GETBAUD ;..ROUTINE RETURNS WITH CHANGE..
JMP FIXBAUD ;..OF BAUD. IF OPT REQUESTED,..
SKIPB1 LDA ORIGFLG ;..A BLANK FORCES 300 BAUD..
ORA A ;..ELSE A 0 FROM NEWBAUD..
JNZ SKIPB2 ;..FORCES 300 BAUD.
CALL GETBAUD
JMP FIXBAUD
SKIPB2 LDA FCB+9
CPI 0 ;IF ZERO, NEWBAUD WANTS 300
JZ SKIPB3
CPI ' '
RZ
JMP SKIPB4
SKIPB3 MVI A,' ' ;FORCE 300 BAUD
STA FCB + 9
SKIPB4 CALL GETBAUD
FIXBAUD CALL OUT$BAUDRP
CPI 52
MVI A,5FH
JC GT300
MVI A,7FH
GT300 CALL OUT$MODCTL2
LDA ORIGFLG
ORA A
MVI A,ORIGMOD
JZ OFFHOOK
LDA ANSWFLG
ORA A
MVI A,ANSWMOD
RNZ
OFFHOOK LXI H,4000
OFFDLY DCR L
JNZ OFFDLY
DCR H
JNZ OFFDLY
CALL OUT$MODCTLP
RET
GETBAUD LDA FCB+9
CPI ' '
MVI A,52
RZ
LDA FCB+9
CPI 0
MVI A,52
RZ
LXI D,FCB+9
LXI H,0
DECLP LDAX D
INX D
CPI ' '
JZ DECLP
CPI '0'
JC BADRATE
CPI '9'+1
JNC BADRATE
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
LXI B,-1
DIVLP INX B
DAD D
JC DIVLP
MOV A,B
ORA A
MOV A,C
RZ
BADRATE CALL ERXIT
DB '++ INVALID BAUD RATE ++$'
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 SHOWHEX
CPI 7FH
JC CTYPE
SHOWHEX 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
TYPE PUSH PSW
PUSH B
PUSH D
PUSH H
MOV C,A
VTYPE CALL $-$
POP H
POP D
POP B
POP PSW
RET
STAT PUSH B
PUSH D
PUSH H
VSTAT CALL $-$
POP H
POP D
POP B
ORA A
RET
KEYIN PUSH B
PUSH D
PUSH H
VKEYIN CALL $-$
POP H
POP D
POP B
RET
UCASE CPI 61H ;CHANGES LOWER CASE CHARACTER..
RC ;..IN A-REG TO UPPER CASE.
CPI 7BH
RNC
ANI 5FH
RET
HEXO PUSH PSW
RAR
RAR
RAR
RAR
CALL NIBBL
POP PSW
NIBBL ANI 0FH
CPI 10
JC ISNUM
ADI 7
ISNUM ADI '0'
JMP TYPE
;RETURNS W/ ZERO SET IF RETRY ASKED. IF MULTI-FILE MODE, THEN
;NO QUESTIONS ASKED, JUST QUIT
CKQUIT LDA BATCHFLG
ORA A
JNZ CKQTASK ;ASK FOR RETRY
INR A ;RESET ZERO FLG
RET
CKQTASK XRA A
STA ERRCT
CALL ILPRT
DB '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'
RZ
CPI 'Q'
JNZ CKQUIT
ORA A
RET
ILPRT XTHL
ILPLP MOV A,M
ORA A
JZ ILPRET
CALL CTYPE
INX H
JMP ILPLP
ILPRET XTHL
RET
PRTMSG MVI C,PRINT
JMP BDOS
ERXIT POP D
CALL PRTMSG
CALL ILPRT
DB BELL,0
LDA BATCHFLG
ORA A
JNZ DONETCE
MVI A,'Q' ;RESET QFLG
STA QFLG
JMP ABORT ;ABORT OTHER COMPUTER
EXIT LXI D,80H
MVI C,STDMA
CALL BDOS
JMP 0
MOVE128 MVI B,128
MOVE MOV A,M
STAX D
INX H
INX D
DCR B
JNZ MOVE
RET
;DIALING ROUTINES TAKEN (AND GREATLY MODIFIED) FROM PMMI MANUAL.
;MODEM CONTROL COMMAND WORDS
CLEAR EQU 3FH ;IDLE MODE
MAKEM EQU 1 ;TELE LINE MAKE (OFF HOOK)
BRKM EQU 0 ;TELE LINE ON HOOK (BREAK DURING DIALING)
DTMSK EQU 1 ;DIAL TONE MASK
TMPUL EQU 80H ;TIMER PULSES MASK BIT
TRATE EQU 250 ;VALUE FOR 0.1 SECOND
DIALPL LDA PMMIBYTE ;FLAG FOR PMMI OPERATION
ORA A ;SET FLAGS
RZ ;PMMI FALSE, RETURN
7 XRA A ; 0
7 STA CRFLAG ;CONTINUOUS REDIAL FLAG
CALL DIALPL0 ; DISCONNECT, RECONNECT, WAIT DIAL TONE
7 JC DILAGN ;ASK IF TRY AGAIN
7 LXI H,CMDBUF+1 ;POINT # OF CHARS IN BUFF
7 MOV A,M ;GET # OF CHARS
7 CPI 4 ;4 OR MORE CHARS TYPED BEFORE <CR>?
7 JC ENTNUM ;NO, ASK FOR NUMBER
7 LXI H,CMDBUF+5 ;POINT TO NUMBER TO DIAL
7 JMP DIAL10 ;CHECK IF LIB #, & DIAL
DIALPL0 CALL DISCONNT
CALL ILPRT
DB CR,LF,'WAITING FOR DIAL TONE',CR,LF,0
MVI A,MAKEM ;MAKE MAKE (OFF-HOOK)
CALL OUT$MODCTLP;DO IT
MVI D,DTMSK ;DIAL TONE MASK
MVI C,100 ;10 SECOND WAIT
CALL WAIT ;WAIT FOR DIAL TONE
7 NOP ;DELAY
; WAIT SUBROUTINE WILL RETURN WITH CARRY SET IF UNABLE TO
; GET DIALTONE, ELSE CARRY NOT SET MEANS DIALTONE RECEIVED
RNC ;IF DIAL TONE WITHIN 10 SECONDS
CALL ILPRT ;ELSE, MESSAGE AND RETURN WITH CARRY SET
DB CR,LF
DB '++NO DIAL TONE AFTER 10 SECONDS++',CR,LF,0
STC
RET
ENTNUM: ;this is all the set-up for the print at entnum2.
7 mvi c,13 ;number of lines to move
7 lxi h,numblib ;address of source memory
7 lxi d,dbuf ;address of target memory
7 call newline ;start with CRLF
7 stax d ;+LF
7 inx d ;and bump it
entnum1:
7 mvi b,30 ;number of bytes to move
7 call move ;move to buffer
7 call spaces ;2 entries + 3 spaces = 63 characters
7 mvi b,30
7 call move
7 call newline
7 dcr c ;number of lines to print
7 jz entnum2
7 jmp entnum1
newline: ;puts CR-LF at memory pointed by DE
7 mvi a,cr ;CR
7 stax d ;store it
7 mvi a,lf ;LF
7 inx d ;bump pointer
7 stax d ;store LF
7 inx d ;bump pointer
7 ret
spaces:
7 mvi a,20H ;space
7 stax d ! inx d ; 1
7 stax d ! inx d ; 2
7 stax d ! inx d ; 3
7 ret
entnum2:
mvi a,'$'
stax d
mvi c,print
lxi d,dbuf ;point to table of numbers to print
call bdos
call crlf
CALL ILPRT
DB 'ENTER NUMBER OR LIBRARY LETTER - TYPE C/R WHEN FINISHED,',CR,LF
DB 'CTRL-X CANCELS WHILE DIALING: ',0
LXI D,CMDBUF
CALL INBUFF
DIALLP1 LDA CMDBUF+1
ORA A ;NULL MEANS <CR> WAS TYPED
JZ BORTIT ;ABORT DIALING, RETURN TO MENU
LXI H,CMDBUF+2 ;FIRST TYPED CHAR OF NUMBER TO DIAL
7 ;
7 ; ENTER THIS ROUTINE WITH HL POINTING TO NUMBER TO DIAL
7 ;
DIAL10:
7 MVI B,'A' ;FIRST LETTER OF ALPHABET
7 MVI E,0 ;COUNTS NUMBER OF LETTERS TO MATCH
7 MVI C,26 ;NUMBER OF LETTERS IN ALPHABET
7 MOV A,M ;GET CHAR BUFFER
DIAL11:
7 CMP B ;NUMBER FROM TABLE?
7 JZ LIBSET
7 INR B ;MAKE NEXT LETTER (A-Z)
7 INR E ;COUNT UP
DCR C ;COUNT DOWN
7 JZ DIALLPX ;NOT A LETTER
7 JMP DIAL11 ;LOOP
LIBSET:
7 LXI H,NUMBLIB ;PHONE NUMBER LIBRARY
7 LXI B,30 ;LENGTH OF LIBRARY ENTRY
7 MOV A,E ;NUMBER OF TIMES TO ADD 30 TO HL
7 ORA A ;SET FLAGS
7 JZ DIAL13
DIAL12:
7 MOV A,M ;GET FIRST CHAR OF SELECTED LIB ENTRY
7 ORA A ;SET FLAGS
7 JZ DIALLP2 ;SEND BADLIB MSG
7 DAD B ;INCREMENT HL BY 30
7 DCR E ;COUNTDOWN
7 JNZ DIAL12 ;NOT THERE YET, LOOP
DIAL13:
7 MVI E,30 ;NUMBER OF CHARACTERS TO GET FROM TABLE
7 JMP DIALLP2
DIALLPX LDA CMDBUF+1
MOV E,A ;NUMBER OF CHARS IN BUFF
LXI H,CMDBUF+2 ;POINT FIRST CHAR
DIALLP2 MOV A,M ;GET FIRST # FROM BUFFER
7 ;
7 ; ROUTINE TO PRINT 'BADLIB' MESSAGE AND ABORT IF NULL ENCOUNTERED
7 ;
7 ORA A ;SET FLAGS
7 PUSH D ;SAVE DE REGISTERS
7 LXI D,BADLIB ;BAD LIBRARY NUMBER IF NULL
7 MVI C,PRINT ; 9
7 PUSH PSW ;SAVE A AND FLAGS
7 CZ BDOS
7 POP PSW ;RESTORE A AND FLAGS
7 POP D ;RESTORE DE REGISTERS
7 JZ BORTIT ;ABORT
;
; DIAL A DIGIT, CHECK KBD FOR ABORT
;
CALL DIAL ;DIAL IT
CALL STAT ; KEYPRESS?
ORA A ;SET FLAGS
CNZ KEYIN ;YES, GO GET IT
CPI CAN ; ^X?
JZ BORTIT ;YES, ABORT
INX H ;BUMP POINTER
PUSH D ;SAVE DE
PUSH H ;SAVE HL
MVI B,1 ;WAIT 1 TIME INTERVAL
CALL TIMER
POP H ;RESTORE HL
POP D ;RESTORE DE
DCR E ;COUNT DOWN CHARS IN BUFF
JNZ DIALLP2 ;NOT DONE, LOOP
JZ DIALDN ;DIALING DONE
DISCONNT
XRA A ;0
CALL OUT$MODCTL2 ;CLEAR DAV, ESD, ETC
CALL OUT$MODCTLP ;HANG-UP
PUSH B
MVI B,8 ;wait for PMMI to disconnect
CALL TIMER
POP B
RET
TIMER MVI A,TRATE ;TRATE 250, VALUE FOR .1 SEC INTERVAL
CALL OUT$BAUDRP ;B-REG CONTAINS NUMBER OF .1 SEC INTERVALS
TIMES CALL IN$BAUDRP ;TO COUNT
ANI TMPUL
JZ TIMES ;WAIT FOR TIMER TO GO HIGH
TIMEE CALL IN$BAUDRP
ANI TMPUL
JNZ TIMEE ;WAIT FOR TIMER TO GO LOW
DCR B
JNZ TIMES
RET
BORTIT CALL DISCONNT
JMP MENU
;AUTO DIALER
DIAL CALL TYPE ;PRINT WHATEVER CHARACTER, DASHES, ETC.
CPI 30H
RC ;DIGIT MUST BE AT LEAST 0..
CPI 3AH
RNC ;..AND NOT MORE THAN 9
ANI 0FH ;STRIP ASCII -- COULD ALSO DO SUI 30H ('0')
CPI 0
JNZ DIALS
MVI A,10 ;CONVERT ZERO TO 10 PULSES
DIALS MOV C,A
LDA PULSERATE ;CONTAINS VALUE FOR DIAL SPEED
CALL OUT$BAUDRP
DIALC CALL IN$BAUDRP
ANI TMPUL
JNZ DIALC
DIALB CALL IN$BAUDRP
ANI TMPUL
JZ DIALB
MAKEP MVI A,MAKEM
CALL OUT$MODCTLP
TIMEM CALL IN$BAUDRP
ANI TMPUL
JNZ TIMEM
MVI A,BRKM
CALL OUT$MODCTLP
TIMEB CALL IN$BAUDRP
ANI TMPUL
JZ TIMEB
DCR C
JNZ MAKEP
MVI A,MAKEM
CALL OUT$MODCTLP
MVI B,2
CALL TIMER
RET
;TIME OUT ROUTINE. MUST BE CALLED WITH MASK IN D REG FOR INPUT
;AT RELATIVE PORT 2 AND NUMBER OF SECONDS * 10 IN C REG.
WAIT MVI B,1
CALL TIMER ;WAIT FOR TIMER TO GO HIGH THEN LOW
CALL IN$BAUDRP ;PMMIADDR+2 (MODEM STATUS PORT)
ANA D ;(CTS or DIALTONE MASK)
RZ ;ACTIVE LOW, SO RETURN ON 0
7 PUSH B ;SAVE..
7 PUSH D ;..ACTIVE REG'S
7 CALL STAT ;KEYPRESS?
7 ORA A ;SET FLAGS
7 CNZ KEYIN ;YES, GET CHAR
7 CPI CAN ;^X?
7 JZ WAIT1 ;YES, DISCONNECT, JMP TO MENU
7 POP D ;RESTORE..
7 POP B ;..REGS
DCR C ;COUNT-DOWN
JNZ WAIT
STC ;SET CARRY TO INDICATE MASK NOT SET
RET
WAIT1:
7 POP D ;RESET..
7 POP B ;..STACK
7 JMP DISCON1 ;DISCONNECT
HANGP MVI A,CLEAR
CALL OUT$MODCTL2
MVI A,0
CALL OUT$MODCTLP
RET
DIALDN CALL CRLF
MVI A,07FH ;TURN ON DTR
CALL OUT$MODCTL2 ;TIMER RATE?
MVI B,1
CALL TIMER ;WAIT FOR MODEM TO TURN ON DTR
MVI A,5DH ;2 STOP BITS, NO PARITY, 8 DATA BITS
;+ NO DISCONNECT AFTER 17 SECS
CALL OUT$MODCTLP
MVI D,4 ;CLEAR TO SEND MASK
MVI C,waitcts ;wait time for cts (25.5 SEC MAX)
CALL WAIT
JNC CONMADE ;CONNECTION MADE
CALL DISCONNT
DILAGN:
7 LDA CRFLAG ;CONTINUOUS REDIAL FLAG
7 ORA A
7 JNZ DILAGN0
CALL ILPRT
DB CR,LF,'No answer after time-out. Redial? (Y/N/C): ',BELL,0
CALL KEYIN ;GET RESPONSE
CALL TYPE ;ECHO IT
CALL UCASE ;ANI 5FH
CALL CRLF ;NEW LINE
CPI 'N' ;REDIAL?
JZ MENU ;NO, GO MENU
CPI 'Y' ;REDIAL?
JZ DILAGN0 ;YES, REDIAL
7 CPI 'C' ;CONTINUOUS REDIAL?
7 JNZ DILAGN ;INVALID RESPONSE, ASK AGAIN
7 XRA A ! CMA ;0FFH
7 STA CRFLAG ;CONTINUOUS REDIAL FLAG
7 DILAGN0:
7 mvi b,50 ;5 seconds wait for pmmi reset
7 call timer ;else busy tone may be sensed as dialtone
CALL DIALPL0 ;WAIT FOR DIAL TONE
JNC DIALLP1 ;DIAL NUMBER
7 JMP DILAGN ;NO DIAL TONE AFTER 10 SECS
CONMADE CALL ILPRT
DB CR,LF,'Connection established - Select options: ',BELL,0
DILAGN1
7 CALL STAT ;KEYPRESS?
7 ORA A ;SET FLAGS
7 JNZ GETCMD ;KEY PRESSED, GO GET OPTIONS
7 MVI A,BELL
7 CALL TYPE ;RING BELL
7 JMP DILAGN1 ;LOOP
;INITIALIZES CP/M FILE CONTROL BLOCKS AT 5CH AND 6CH
SETFCB LXI D,CMDBUF
LXI H,FCB
CALL CPMLINE
CALL PROCOPT
CHECKNM LDA FCB+1 ;CHECK ON THE PRIMARY OPTION
CPI 'E' ;RETURN IF ECHO OPTION
RZ
CPI 'M' ;RETURN TO MENU
RZ
MOV B,A
LDA PMMIBYTE
ORA A
MOV A,B
JZ S4
CPI 'C'
RZ
S4 CPI 'T'
JZ TERMSEL
CPI 'S'
JZ CKFILE
CPI 'R'
JNZ BDOPT
LDA BATCHFLG ;IF MULT FILE MODE, THEN..
ORA A ;..RECV OPT DOES NOT NEED..
RZ ;..NAME.
JMP CKFILE
BDOPT CALL ILPRT
DB CR,LF,'++Bad Option++',CR,LF,0
JMP REENT
CKFILE LDA FCB+17 ;IF OPTION THAT NEEDS FILE NAME,..
CPI ' ' ;..THEN CHECK TO SEE IF NAME..
RNZ ;..EXISTS. IF NOT..
REENT CALL ILPRT ;..DO EVERYTHING OVER.
DB CR,LF,'Re-enter PRIMARY option and file name only: ',BELL,0
LXI D,CMDBUF
CALL INBUFF
JMP SETFCB
TERMSEL LDA FCB+17
CPI ' '
JNZ SAVAGN
MVI A,FALSE
STA SAVEFLG
MVI A,TRUE
STA NFILFLG
CMA
OUT FRONTPAN
RET
SAVAGN MVI A,FALSE
STA NFILFLG
RET
NEWBAUD LDA PMMIBYTE
ORA A
RZ
CALL ILPRT
DB 'Enter New Baudrate: ',0
LXI H,FCB+9
MVI M,0 ;PUTS A ZERO IN FIRST POSITION SO AS TO
LOOP5 CALL KEYIN ;FORCE THE DEFAULT OPTION OF 300 BAUD.
CPI CR ;CARRIAGE RET ENTERS BAUD RATE
JNZ CONNEWB ;GOES TO THE ESTABLISHED ROUTINE - RETURN TO MAIN
CALL CRLF ;PROGRAM IS DONE THERE.
JMP SETBAUD
CONNEWB CPI 30H ;MAKE SURE IT'S..
JC LOOP5 ;..A DIGIT, ELSE..
CPI 3AH ;..DON'T ACCEPT IT.
JNC LOOP5
MOV M,A
MOV C,A
CALL TYPE ;ECHO THE CHARACTER ENTERED
INX H
JMP LOOP5
MENU LXI H,RESTSN ;RESTORE SECTORE NUMBERS..
LXI D,SECTNOB ;..FOR NEW FILE TRANSFER.
MVI B,SECTNOE-SECTNOB
CALL MOVE
LXI H,RESTROPT ;RESTORE OPTION TABLE
LXI D,OPTBL
MVI B,OPTBE-OPTBL
CALL MOVE
MVI A,0
STA MFFLG1 ;RESET MFACCESS ROUTINE..
CMA ;..AND MULTI TRANS IN CASE..
STA FSTFLG ;..OF ABORT.
MENU1 LDA XPRFLG ;TEST IF MENU SHOULD BE SHOWN
ORA A
JNZ XPRT
CALL ILPRT
DB CR,LF,CR,LF
DB 'WRT - Write file to disk (from terminal mode)',CR,LF
DB 'DEL - Erase present file (from terminal mode)',CR,LF
DB 'RET - Return to terminal mode with no loss of data',CR,LF,0
LDA PMMIBYTE
ORA A
JZ S5
CALL ILPRT
DB 'DSC - Disconnect',CR,LF
DB 'CAL - Dial number',CR,LF,0
S5 CALL ILPRT
DB 'XPR - Toggle expert mode (Menu on/off)',CR,LF
DB 'DIR - List directory (may specify drive)',CR,LF
DB 'CPM - Exit to CP/M',CR,LF
DB 'S - Send CP/M file',CR,LF
DB 'R - Receive CP/M file',CR,LF
DB 'T - Terminal mode (optional file name)',CR,LF
DB 'E - Terminal mode with echo',CR,LF,0
XPRT CALL ILPRT
DB CR,LF,CR,LF,'DEFAULT DRIVE: ',0
MVI C,25 ;CURRENT DISK FUNCTION
CALL BDOS
ADI 41H ;MAKE ASCII
CALL TYPE
CALL ILPRT
DB CR,LF,CR,LF,'Command: '
DB 0
GETCMD LXI D,CMDBUF ;ENTER COMMAND
CALL INBUFF
CALL CRLF
LXI D,CMDBUF+2 ;POINT TO COMMAND
CALL ILCOMP
DB 'CPM',0
JNC EXIT
CALL ILCOMP
DB 'DIR',0
JNC DIR
CALL ILCOMP
DB 'RET',0
JC NXTOPT1 ;CARRY SET = NO MATCH
LHLD HLSAVE ;RETURN TO TERMINAL..
JMP TERM ;..MODE WITH SAVE OPTION..
;..IF PREVIOUSLY ENABLED.
NXTOPT1
LDA PMMIBYTE
ORA A
JZ S6
CALL ILCOMP ;DE SET FROM 1ST ILCOMP CALL
DB 'DSC',0
JNC DISCON1
S6 CALL ILCOMP
DB 'WRT',0
JNC WRTFIL
CALL ILCOMP
DB 'XPR',0
JNC XPRMODE
CALL ILCOMP
DB 'DEL',0
JNC NEWFILE
LDA PMMIBYTE
ORA A
JZ NXTOPT2
CALL ILCOMP
DB 'CAL',0
JC NXTOPT2
MVI A,1 ;FORCE 1 IN CHAR COUNT OF..
STA CMDBUF+1 ;..CMDBUF SO THAT IT ONLY..
JMP DOOPT ;..LOOKS AT 'C' FOR DIAL
NXTOPT2 PUSH H
LDA CMDBUF+2
LXI H,COMPLIST
CALL COMPARE ;COMPARES LIST POINTED TO BY HL..
POP H ;..TO CHAR IN A-REG.
JC MENU1 ;CARRY SET = NO MATCH
DOOPT PUSH H ;LOAD ORIGINAL FCB WITH TRANSFER..
CALL SETFCB ;..CMDS AND GO TO BEGINNING OF..
POP H ;..PROGRAM. WILL FOLLOW SAME LOGIC..
JMP RESTART ;..AS IF PROGRAM WERE CALLED WITH..
;..CP/M COMMAND LINE.
DISCON1 LDA PMMIBYTE
ORA A
JZ MENU
CALL DISCONNT
CALL ILPRT
DB CR,LF,'++DISCONNECTED++',CR,LF,BELL,0
JMP MENU1
DIR CALL DIRLST
JMP XPRT
NEWFILE LDA FCB3+1
CPI ' '
JZ MENU1 ;IF NO FILE, DON'T ERASE
LXI D,FCB3
MVI C,ERASE
CALL BDOSRT
MVI A,TRUE ;DO NOT ALLOW TERMINAL..
STA NFILFLG ;..SAVE SINCE NO FILE..
CMA ;..SPECIFIED.
STA SAVEFLG
OUT FRONTPAN
LXI H,FCB3
CALL INITFCBS
JMP MENU1
WRTFIL LDA NFILFLG
CPI TRUE
JZ MENU1
LDA FCB3+1 ;CHECK THAT FILE WAS REQUESTED
CPI ' '
JZ MENU1
LHLD HLSAVE
CALL NUMRECS ;DISK WRITE ROUTINE AS USED IN..
CALL WRTDSK ;..IN THE INTDSKSV ROUTINE.
CALL CLOSE3
MVI A,TRUE
STA NFILFLG
CMA
STA SAVEFLG
OUT FRONTPAN
LXI H,FCB3
CALL INITFCBS ;BLANK OUT FCB SO WRITTEN FILE..
JMP MENU1 ;..CAN'T BE ERASED.
XPRMODE LDA XPRFLG
CMA
STA XPRFLG
JMP MENU1
COMPARE MOV B,M ;COMPARES A-REG 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
COMPLIST DB 4, 'S', 'R', 'T', 'E'
ILCOMP INLNCOMP ;A MACRO IN MACROS.LIB
INBUFF INBUF ;A MACRO IN "MACROS.LIB"
;IF ABOVE ROUTINE DOES NOT LET YOU EDIT IN A PROPER MANNER,
;THEN THE MACRO MAY BE SUBSTITUTED FOR THE FOLLOWING ROUTINE:
;INBUFF MVI C,RDBUF
; CALL BDOSRT
; RET ;BUT BE CAREFUL OF CONTROL-C
CPMLINE CMDLINE ;A MACRO IN "MACROS.LIB"
DIRLST DIRLIST ;A MACRO IN "MACROS.LIB"
NFILFLG DB FALSE ;NORMALLY SET TO FALSE. ALLOWS WRITE TO..
;..MEMORY IN TERMINAL MODE.
OPTION DB 0
OPTBL EQU $
ANSWFLG DB 'A'
DISCFLG DB 'D'
ORIGFLG DB 'O'
QFLG DB 'Q'
RSEEFLG DB 'R'
SSEEFLG DB 'S'
VSEEFLG DB 'V'
TERMFLG DB 'T'
BATCHFLG DS 1 ;SET TO 'B' BY MENU. DOES NOT ALLOW MULTI-..
OPTBE EQU $ ;..FILE XFER WHEN PROGRAM INITIALLY CALLED.
RESTROPT ;MUST BE IN SAME ORDER AS TABLE ABOVE
DB 'A','D','O','Q','R','S','V','T','B'
RESTSN DB 0,0,0,0
DW DBUF
DB 0
DB 0
SECTNOB EQU $
RCVSNO DB 0
SECTNO DB 0
ERRCT DB 0
EOFLG DB 0
SECPTR DW DBUF
SECINBF DB 0
DATAFLG DB 0
SECTNOE EQU $
BADOPT CALL ILPRT
DB 'INVALID OPTION',CR,LF,BELL,0
JMP MENU
FSTFLG DB TRUE
CMDBUF DB 80H,0
DS 80H
BADLIB DB CR,LF,'++BAD LIBRARY NUMBER CALLED++',CR,LF,'$'
HLSAVE DS 2
DISKNO DS 1
SENDFLG DS 1
NBSAVE DS 2
BGNMS DS 2
FILECT DS 1
NAMECT DS 1
DS 40
STACK DS 2
FCB3 DS 33
FCBBUF DS 15
DBUF DS 16*128 ;16 SECTOR DISK BUFFER
NAMEBUF DS 1 ;BUFFER FOR NAMES IN BATCH MODE. OVERFLOWS..
;..ABOVE PROGRAM CODE.
; BDOS EQUATES
RDCON EQU 1
WRCON EQU 2
PRINT EQU 9
RDBUF EQU 10
CONST EQU 11
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
STDMA EQU 26
BDOS EQU 5
REIPL EQU 0
FCB EQU 5CH
FCBEXT EQU FCB+12
FCBSNO EQU FCB+32
FCBRNO EQU FCB+32
FCB2 EQU 6CH
LAST END 100H