Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / sigm / vol149 / modem7-z.asm < prev next >

Wrap

Assembly Source File | 1984-04-29 | 45.4 KB | 2,376 lines

page 56 title 'CP/M MODEM7 PROGRAM' ; 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 granted to use, but not to sell, these routines. ; 13 Feb 83 Modified by S. E. Andrews, major changes marked "** TA" ; ; Note: All Baud Rates supported by the Z100 and this program do ; work. However, only baud rates up to 1200 should be considered ; reliable since the received 'Characters Per Second' above 1200 ; 'Bits Per Second' are generally too fast for this programs ; BIOS CALLS to handle when viewing the file being transfered. ; 38400 baud will not support file transfers at all, 19200 will ; file transfer most of the time, 9600 and 4800 will generally ; transfer files if not viewed. ; ; 13 Oct 82 Modified by Robert A. Ross Jr to work with ; the H-89 system with the H-89-11 Multi-mode ; card installed. This revision will also work ; on the Zenith Z-100 using CP/M-85. ; ; Set the following equates depending on which system ; you are using: ; LABEL H-89 Z-100 ; PORT 0D8H 0ECH ; FASTCLK FALSE TRUE ; ; REVISION 6 January 1982 by Sanford R. Smith ; -- Modified MODEM7 to operate ; on the HEATH / ZENITH H89/Z89 Systems using CPM. ; Modification assumes use of the 8250 ACE. ; ;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. FALSE EQU 0 TRUE EQU NOT FALSE ; PMMI EQUATES PORT EQU 0ECH ;modem BASE ADDRESS moddatp equ port ;modem data port modlcr equ port+2 ;MODE CONTROL REGISTER modmcr equ port+3 ;COMMAND REGISTER modlsr equ port+1 ;STATUS REGISTER MODSNDB EQU 01H ;MODEM SEND BIT (XMIT BUFF EMPTY) MODSNDR EQU 01H ;MODEM SEND READY MODRCVB EQU 02H ;MODEM RECEIVE BIT (DAV) MODRCVR EQU 02H ;MODEM RECEIVE READY ; MODIER EQU 00H MODIIR EQU 00H MODMSR EQU PORT+1 MODDLL EQU 00H MODDLM EQU 00H ; ; ; DEFINITIONS FOR 2661-2 EPCI (ENHANCED PROGRAMMABLE COMM. INTERFACE) ; EP$BAS EQU 0ECH ;2661-2 BASE ADDRESS ; ; PORT DISPLACEMENTS ; EP$DAT EQU 0 ;DATA EP$SR EQU 1 ;STATUS REGISTER EP$MR1 EQU 1 ;STATUS EP$MR2 EQU 2 ;MODE REGISTER 2 EP$CR EQU 3 ;COMMAND REGISTER EP$INT EQU 4 ;INTERRUPT ENABLE (Z-89-11, NOT PART OF 2661) ; ; STATUS REGISTER BITS ; SR$TXR EQU 00000001B ;TRANSMITTER READY SR$RXR EQU 00000010B ;RECEIVER READY SR$TXE EQU 00000100B ;TRANSMITTER EMPTY SR$DSC EQU 00000100B ;DSR CHANGED STATE SR$PER EQU 00001000B ;PARITY ERROR SR$OVE EQU 00010000B ;OVER RUN ERROR SR$FRE EQU 00100000B ;FRAMING ERROR SR$SYD EQU 00100000B ;SYNC DETECT (SYNC. MODE) SR$DCD EQU 01000000B ;DATA CARRIER DETECT SR$DSR EQU 10000000B ;DATA SET READY ; ; MODE REGISTER 1 (MR1) ; MR1$MBM EQU 00000011B ;MODE AND BAUD CLOCK MASK MR1$S1X EQU 00H ;SYNC. 1X CLK MR1$A1X EQU 01H ;ASNYC. 1X CLK MR1$A16 EQU 02H ;ASYNC. 16X CLK MR1$A64 EQU 03H ;ASYNC. 64X CLK ; MR1$CLM EQU 00001100B ;CHARACTER LENGTH MASK MR1$5BW EQU 00H ;5 BIT CHARACTERS MR1$6BW EQU 04H ;6 BIT CHARACTERS MR1$7BW EQU 08H ;7 BIT CHARACTERS MR1$8BW EQU 0CH ;8 BIT CHARACTERS ; MR1$PEN EQU 00010000B ;PARITY ENABLE (0=DISABLE, 1=ENABLE) MR1$PEV EQU 00100000B ;EVEN/ODD PARITY (0=ODD, 1=EVEN) ; MR1$SBM EQU 11000000B ;(ASYNC.) STOP BIT MASK MR1$1SB EQU 040H ;1 STOP BIT MR1$15B EQU 080H ;1.5 STOP BIT MR1$2SB EQU 0C0H ;2 STOP BITS ; MR1$TSP EQU 01000000B ;(SYNC) TRANSP. MODE (0=NORMAL, 1=TRANSP) MR1$NSC EQU 10000000B ;(SYNC) NR. OF SYNC CHARS (0=SINGLE, 1=DOUBLE) ; ; MODE REGISTER 2 (MR2) ; MR2$BRM EQU 00001111B ;BIT RATE MASK MR2$CKS EQU 11110000B ;CLOCK SELECT MASK (SEE DATA SHEET) ; ; COMMAND REGISTER (CR) ; CR$TXEN EQU 00000001B ;TRANSMITTER ENABLE CR$DTR EQU 00000010B ;DTR ASSERTED (=LOW) CR$RXEN EQU 00000100B ;RECEIVER ENABLED CR$SBRK EQU 00001000B ;SEND BREAK (ASYNC.) CR$SDLE EQU 00001000B ;SEND DLE (SYNC.) CR$RESE EQU 00010000B ;RESET ERRORS IN SR CR$RTS EQU 00100000B ;RTS ASSERTED (=LOW) ; CR$OMM EQU 11000000B ;OPERATING MODE MASK CR$NML EQU 00H ;NORMAL CR$OM1 EQU 40H ;MODE 1 (ASYNC=AUTO ECHO/SYNC=SYN/DLE STRP) CR$OMLL EQU 80H ;LOCAL LOOPBACK CR$OMRL EQU 0C0H ;REMOTE LOOPBACK ; IE$EN EQU 00000001B ;1=ENABLE EPCI INTERRUPTS, 0=DISABLE ; 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 EQU '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-ASSEMBLING ;THE PROGRAM. PMMIBYTE DB TRUE ;true=pmmi modem IMSAIBYTE DB FALSE ;true=imsai front panel FASTCLK DB TRUE ;4 MHz or greater BAKUPBYTE DB TRUE ;true=make .BAK file XPRFLG DB false ;true=no menu, false=print menu IN$MODlsr IN MODlsr ! RET ;in modem control port out$modlsr out modlsr ! ret ; OUT$MODDATP PUSH PSW OUT267 IN EP$BAS+EP$SR ANI SR$TXR JZ OUT267 POP PSW OUT EP$BAS+EP$DAT RET ; ANI$MODSNDB ANI MODSNDB ! RET ;bit to test for send ready CPI$MODSNDR CPI MODSNDR ! RET ;value of send bit when ready IN$MODDATP IN EP$BAS+EP$DAT ORA A ;CLEAR FLAGS RET ANI$MODRCVB ANI MODRCVB ! RET ;bit to test for receive ready CPI$MODRCVR CPI MODRCVR ! RET ;value of receive bit when ready ; Following corrects droping back to default baud rate ** TA ;JMP$INITMOD JMP setbaud ;to initialize port, if necessary JMP$INITMOD JMP INITMOD ;initialize port after S,R,T or E OUT$modlcr OUT MODlcr ! RET ;out modem control port OUT$moddll OUT moddll ! RET ;out baudrate port 1 OUT$moddlm OUT moddlm ! RET ;out baudrate port 2 out$modier out modier ! ret ;out interrupt enable out$modiir out modiir ! ret ;out interrupt id reg out$modmcr out modmcr ! ret ;out modem control reg in$modmcr in modmcr ! ret in$iir in modiir ! ret in$lcr in modlcr ! ret in$msr in modmsr ! ret ;in modem status reg CRFLAG DB 0 ;CONTINUOUS REDIAL FLAG START: LXI H,0 DAD SP ;GET CP/M'S STACK SHLD STACK ;SAVE IT LXI SP,STACK ;START LOCAL STACK CALL INITMOD CALL START1 ; DB CR,LF,' MODEM7 as of 2/16/83',cr,lf ; DB 'Originally Written by: Ward Christensen',cr,lf ; DB 'Revisions by: Mark M. Zeiger, Jim Mills',cr,lf ; DB 'R. Ross Jr., S. R. Smith, S. E. Andrews',CR,LF,LF DB CR,LF,' >>> MODEM7 for the Zenith Z100 Version 1.03 <<<','$' 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 ; Process Menu options ' ', 'M', 'E', 'T', 'S', 'R' RESTART: LDA OPTION ;GET MAIN OPTION CPI ' ' ;NO OPTION SPEC'D? JZ MENU ;TRUE, GO MENU CPI 'M' ;MENU ASKED FOR? JZ MENU ;YES, GO MENU CALL JMP$INITMOD ; initalize modem port CALL MOVEFCB MVI A,FALSE ; reset write to memory STA NFILFLG ; .. in terminal mode 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? ** ?? JMP MENU ;NO OPTION SPEC'D, GO MENU ; REVISED TERMINAL ROUTINE ALLOWING MEMORY SAVE "T" pri command ; Note that characters typed from terminal will be saved ; also because they are echoed back from distant end. DSKSAVE: PUSH PSW XRA A ; undo "E" pri commands patch ** TA STA NOTOG+3 ; by storing 0,0,0 ** | STA NOTOG+4 STA NOTOG+5 STA TERML+0FH ; and another 0,0,0 STA TERML+10H STA TERML+11H ; ** | POP PSW ; ** TA DSKSAV1: LDA NFILFLG ;NEW FILE FLAG ** TA 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 no file specified STA NFILFLG ;.. so no saving CMA ; 0 STA SAVEFLG ; JMP TERM GOODNM: CALL ERASFIL ; see if file exists now and prompt 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 modem CALL KEYIN ; .. yes, GET CHAR FROM KBD CPI EXITCHR ; ^E ? JZ MENU ; .. YES, RETURN TO MENU ; CPI DISCCHR ; ^D ? ** ?? ; JZ menu ; .. YES, DISCONNECT & RETURN TO MENU ** ?? CPI TRANCHR ; ^T ? TEST FOR TRANSFER REQUEST CZ TRANSFER ; .. yes, SEND-A-FILE (BLIND SEND) JZ TERM ; return from transfer and LOOP CPI CHGBAUD ; ^B ? PUSH PSW PUSH H CZ NEWBAUD ; .. yes, so set new baud rate POP H POP PSW CPI CHGBAUD ; ^B ? JZ TERML ; .. if so, already processed so go loop CPI SAVECHR ; ^Y JNZ NOTOG ; .. none of the above so send it LDA NFILFLG ; do not allow save option if CPI TRUE ; .. this flag is FFH. JZ TERML ; .. so ignore ^Y LDA SAVEFLG ; get save flag CMA ; .. toggle it STA SAVEFLG ; .. and save it JMP TERML NOTOG: CALL OUT$MODDATP ; send typed char to modem DB 0,0,0 ; patched by "E" pri command ** TA ; ; to send typed char to terminal TERML: CALL IN$MODlsr ; check modem control port CALL ANI$MODRCVB ; anything at modem CALL CPI$MODRCVR ; .. to read JNZ TERM ; no, so loop again CALL IN$MODDATP ; yes, so get it DB 0,0,0 ; patched by "E" pri command ** TA ; ; to echo character rcvd by ; ; the modem back to the modem ; ; and add LF if CR CPI 0 ; NUL ? JZ TERM ; yes, don't process ANI 7FH ; strip parity cpi 7fh ; DEL ? jz term ; yes, don't process CPI 07H ; less than a BEL ? ** TA JC TERML2 ; .. yes, so only save it ** | CPI 0EH ; less than a SO ? JC TERML1 ; .. yes, so ok to send to terminal CPI 20H ; less than a SPACE ? ** | JC TERML2 ; .. yes, so only save it ** TA TERML1: CALL TYPE ; send to terminal ** TA TERML2: PUSH PSW ; ** TA LDA SAVEFLG CPI FALSE JZ NOSAVE ; don't save, loop POP PSW MOV M,A ; save it INX H SHLD HLSAVE ;MENU COMMAND DESTROYS HL-REG.. ;..GET HL WHEN ENTERING VIA 'RET' CMD. 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$MODlsr 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,LF,'++ FILE DOES NOT EXIST ++',CR,LF,BELL,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,LF,'++ FILE TRANSFER COMPLETED ++',CR,LF,BELL,0 JMP RETURN RETURNU: CALL ILPRT DB CR,LF,LF,'++ FILE TRANSFER UNSUCCESSFUL ++',CR,LF,BELL,0 JMP RETURN TRANCAN: CALL ILPRT DB CR,LF,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$MODlsr CALL ANI$MODSNDB CALL CPI$MODSNDR JNZ MODOUTL POP PSW CALL OUT$MODDATP CALL TYPE RET FCB4: DS 33 ; TERMINAL ECHO MODE WITH OPTIONAL SAVE "E" pri command ; Note that characters typed from terminal can not be saved ; because they are not echoed back from distant end. PROTECT: CPI 07H ; less than a BEL ? ** TA RC ; .. yes, so forget it ** | CPI 0EH ; less than a SO ? JC PROTEC1 ; .. yes, so ok to send to terminal CPI 20H ; less than a SPACE ? RC ; .. yes, so forget it PROTEC1: CALL TYPE ; send it to terminal RET CONVERS: CALL OUT$MODDATP ; send character out on modem ; (place future "save" of typed ; characters from terminal here) RET TRMECHO: PUSH H ! PUSH PSW ! PUSH B ! PUSH D MVI A,0CDH ; CALL instruction STA NOTOG+3 ; .. patched in STA TERML+0FH ; .. two places LXI H,PROTECT ; what to call, check for bad character SHLD NOTOG+4 ; where to store it LXI H,CONVERS ; what to call, send echo back to modem SHLD TERML+10H ; where to store it POP D ! POP B ! POP PSW ! POP H ; ** | JMP DSKSAV1 ; routine to use after it's patched ** TA ;TRMECHO: CALL IN$MODlsr ; look at modem control port ; CALL ANI$MODRCVB ; ; CALL CPI$MODRCVR ; anything there ? ; JZ LINECHR ; .. yes, go get it ; CALL STAT ; anything from the terminal ? ; JZ TRMECHO ; .. no, loop ; CALL KEYIN ; .. yes, get it ; CPI EXITCHR ; ^E ? ; JZ MENU ; .. yes, do a menu ; CPI CHGBAUD ; ^B ? ; PUSH PSW ; CZ NEWBAUD ; .. yes, change baud ; POP PSW ; CPI CHGBAUD ; it might be ^B ; JZ TRMECHO ; .. if it is, we already processed so loop ; CALL OUT$MODDATP ; .. if none of the above, send it to modem ; CALL TYPE ; .. and to the terminal ; JMP TRMECHO ; loop again LINECHR: CALL IN$MODDATP CALL OUT$MODDATP CALL TYPE JMP TRMECHO ; SEND A CP/M FILE "S" pri command 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 "R" pri command 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,BELL,'$' 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,BELL,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 MOV A,0 ;SEND NULLS CALL SEND MOV A,0 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,BELL 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$MODlsr CALL ANI$MODRCVB CALL CPI$MODRCVR JZ MCHAR IN MODLSR ANI 038H JZ MWTI2 IN MODDATP IN MODMCR ORI 010H OUT MODMCR MWTI2: 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$MODlsr 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 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,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 STA SAVEFLG ;STOP MEMORY SAVE IN TERM ROUTINE. LDA VSEEFLG ORA A JZ DONETC LDA QFLG ORA A JZ donetce DONETC: CALL ILPRT DB CR,LF,'ALL TRANSFERS COMPLETED' DB CR,LF,BELL,0 DONETCE: LDA TERMFLG ;SEE IF RETURN TO.. ORA A ;..TERMINAL MODE.. JNZ MENU ;..AFTER X'FER. CALL CRLF JMP TERM INITMOD: LXI H,180h ;Default to 300 baud, H=01 (MS), L=80 (LS) JMP I2661 INITM: PUSH B ; what was in the B/C POP H ; .. is now in the H/L I2661: PUSH B ; PUSH D ; ; ; Fixes selected (^B) baud rate in memory if different than default. ** TA ; ** | SHLD INITMOD+1 ; store baud for LXI H instruction ; ; LS and MS bits of baud refer to 8250 type UART which are used ; here only as a referance point for program indexing. They are ; not a part of the code used to set up the 2661-2 EPCI. ** | ; ** TA XCHG ; swap D/E with H/L.. E = LS bits of baud LXI H,TEPBD ;BAUD RATE CONVERSATION TABLE XRA A ; zero A MOV C,A ; zero C MOV A,E ; move LS bits of baud to A INIT1: CMP M ; compare to table JZ INIT2 ; found it in table INR C ; count number of trys (position in table 0-15) INX H ; get next address in table JMP INIT1 ; go look at it INIT2: MOV A,D ; move MS bits of baud to A ANI 06H ; is it less than 300 baud ** TA JZ INIT3 ; .. no MVI A,MR1$2SB ; .. yes, so 2 stop bits to A JMP INIT4 ; INIT3: MVI A,MR1$1SB ; add 40H (1 Stop Bit) to A INIT4: ADI MR1$8BW+MR1$A1X ; add 0CH (8 Bits) + 01H (Async 1X Clock) to A OUT EP$BAS+EP$MR2 ; send to port 0EEH (Mode Register 2) MVI A,30H ; set the A to 30H ORA C ; combine the position in the table with A ; ; 110/C=3, 300/C=6H, 1200/C=8H, 9600/C=DH OUT EP$BAS+EP$MR2 ; send it to port 0EEH (Mode Register 2) MVI A,CR$NML+CR$RTS+CR$RXEN+CR$DTR+CR$TXEN OUT EP$BAS+EP$CR POP D POP B RET ; ; EPBAUD -- BAUD RATE TABLE FOR 2661-2 "C" *=not supported ** TA ; ** | TEPBD: DB 0FFH ;45.5 0 * DB 0FFH ;50 1 * DB 0FFH ;75 2 * DB 017H ;110 3 DB 0FFH ;134.5 4 * DB 0FFH ;150 5 * DB 080H ;300 6 DB 0C0H ;600 7 DB 060H ;1200 8 DB 0FFH ;1800 9 * DB 0FFH ;2000 10 * DB 030H ;2400 11 DB 018H ;4800 12 DB 00CH ;9600 13 DB 006H ;19200 14 ** | DB 002H ;38400 15 ** TA ; ; delay: lxi b,10000 delay1: dcx b mov a,b ora c jnz delay1 ret SETBAUD: CALL GETBAUD ;..ROUTINE RETURNS WITH CHANGE.. call initm ;Go set the new rate ret GETBAUD: LXI b,180h ; ** TA LDA FCB+9 ; ** | CPI '1' ;110, 1200, 19200 baud JZ ONEZY CPI '3' ;300, 38400 baud JZ THREEZY CPI '6' ;600 baud LXI b,0C0H RZ CPI '2' ;2400 baud LXI B,030H RZ CPI '4' ;4800 baud LXI B,018H RZ CPI '9' ;9600 baud LXI B,00CH RZ JMP OUTZY ONEZY: LDA FCB+10 CPI '1' ;110 baud LXI B,417H RZ CPI '2' ;1200 baud LXI B,060H RZ CPI '9' ;19200 baud LXI B,006H RZ JMP OUTZY THREEZY: LDA FCB+10 CPI '0' ;300 baud LXI b,180H RZ CPI '8' ;38400 baud LXI B,002H RZ OUTZY: CALL ILPRT DB CR,LF DB '++ INVALID BAUD RATE ++ Baud Rate defaults to 300' DB CR,LF,LF,BELL,0 LXI B,180H ; default is 300 baud ** | RET ; ** TA ; ;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 ;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,BELL,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: CALL ILPRT ; (4) ** TA DB CR,LF,LF DB 'Valid baudrates are: 110, 300, 600, 1200, ' DB '2400, 4800, 9600, 19200 and 38400.' DB CR,LF DB 'Enter New Baudrate: ',0 LXI H,FCB+9 ; MVI M,0 ;PUTS A ZERO IN FIRST POSITION SO AS TO LOOP5: call stat jz 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,LF 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,LF DB '------------------- FILE TRANSFER MODE -------------------',CR,LF DB 'S - Send CP/M file using protocol. ^X cancels',CR,LF DB 'R - Receive CP/M file using protocol.',CR,LF,LF DB '--------------- TERMINAL CONVERSATION MODE ---------------',CR,LF DB 'WRT - Write save file to disk and close it.',CR,LF DB 'DEL - Erase save file and abort save.',CR,LF DB 'RET - Return to terminal mode.',cr,lf DB 'T - No echo Conversation mode (optional save file name)',CR,LF DB 'E - Echo Conversation mode (optional save file name)',CR,LF DB ' ^Y toggle save to file (":" indicates on)',CR,LF DB ' ^B change baud rate ^T transfer file',CR,LF DB ' ^E return to menu ^X cancel transfer',0 ; XPRT: CALL ILPRT DB CR,LF,LF,'DEFAULT DRIVE: ',0 MVI C,25 ;CURRENT DISK FUNCTION CALL BDOS ADI 41H ;MAKE ASCII CALL TYPE CALL ILPRT DB CR,LF,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: 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. 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 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 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,BELL,'$' ** ?? 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