;MODEMH is a version of MODEM7A, incorporating a facility to ;hand over control to a remote computer ;For details of the added facility see the file HMODEM.DOC ;This configuration is for a Sorcerer. If reconfiguring, ;note that the added section at the end is written to be ;independent of the main program ;MODEM7A IS AN EXTENSIVE REVISION OF THE CP/M MODEM PROGRAM ;CREATED BY WARD CHRISTENSEN FOR THE CP/M USERS LIBRARY. ;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. ;LAST REVISION 31/Jan/82 Set up for Interfacer ;LAST REVISION 12/18/80 Changed disconnect timing ;This MODEMH augmentation is by Charles Hamblin, 6 Jan 1983 MACLIB MODEM7 ;CONTAINS CMDLINE, INBUF, INLNCOMP, ;DIR, AND MFACCESS ROUTINES ;changed to MODEM.LIB by Jim Mills ;to differentiate from other 'MACROS.LIB' TRUE EQU 0FFH FALSE EQU 0 MODCTLP EQU 0fdh ;MODEM STATUS 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 0fch ;MODEM DATA PORT BAUDRP EQU 0feh ;BAUD RATE PORT MODCTL2 EQU 0fdh ;2ND MODEM CONTROL PORT ORIGMOD EQU 1DH ;ORIGINATE MODE ANSWMOD EQU 1EH ;ANSWER MODE 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 ;Additional equates for handover routines ;For defines, see the end of the listing haven equ 0bc00h ;on MY Sorcerer - alter as needed eschar equ 1bh mdatp equ moddatp mstatp equ modctlp base equ 0 ;THESE ROUTINES ARE AT THE BEGINNING OF THE PROGRAM SO ;THEY CAN BE PATCHED BY A MONITER WITHOUT RE-ASSEMBLING ;THE PROGRAM. nulno: db 4 ;no of nulls for delay during file transfer baudbyt db 80h ;0c0h for 1200, 80h for 300 IMSAIBYTE DB FALSE ;true=imsai front panel FASTCLK DB false ;4 MHz or greater BAKUPBYTE DB TRUE ;true=make .BAK file XPRFLG DB FALSE ;true=no menu, false=print menu 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 ready 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 ; 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,'MODEMH as of 6 Jan 83',cr,lf db 'Adapted by Charles Hamblin from the MODEM7 of Ward',cr,lf db 'Christensen, Mark M. Zeiger, Jim Mills, Bill Bolton',cr,lf,'$' ; bottram dw 0 ;will calculate ; START1: POP D ;GET ADDRESS OF ABOVE MESSAGE MVI C,PRINT ; 9 CALL BDOS lxi h,last+100h mvi l,0 shld bottram ;calc rplaces orig def CALL INITADR ;INITIALIZE ADDRESSES MVI A,TRUE ; 0FFH STA NFILFLG CMA ; 0 STA SAVEFLG 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 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 hechek ;YES (will disallow when handover) 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 cpi 'H' jz rgiv ;handover option 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 JMP TERM GOODNM: CALL ERASFIL CALL MOVE2 LXI D,FCB3 MVI C,MAKE CALL BDOS LXI D,FCB3 MVI C,OPEN CALL BDOS lhld BOTTRAM SHLD HLSAVE MVI A,FALSE STA NFILFLG TERM: CALL STAT ;KEYPRESS? JZ TERM2 ;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 CPI SAVECHR JNZ NOTOG LDA NFILFLG ;DO NOT ALLOW SAVE IF.. CPI TRUE ;..THIS FLAG IS SET. JZ TERM2 LDA SAVEFLG CMA STA SAVEFLG term2: call qhando ;ret z if handed over? jz term JMP TERML ; NOTOG: call qhando jz terml2 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 terml2: 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..(deleted) 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 lhld 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: xchg lhld bottram mov a,l cma mov l,a mov a,h cma mov h,a inx h xchg 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: xchg lhld bottram xchg 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 hechek: call qhando ;ret z if handed over jz menu ;echo mode disallowed TRMECHO: CALL IN$MODCTLP CALL ANI$MODRCVB CALL CPI$MODRCVR JZ LINECHR CALL STAT JZ TRMECHO CALL KEYIN CPI EXITCHR JZ MENU 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 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 xra a ;no echo in handover mode sta echfl+haven-rcan 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: call nulsend 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 xra a sta echfl+haven-rcan ;no echo after the first when handed over 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: call nulsend ;send (nulno) nulls MVI A,SOH CALL SEND LDA SECTNO CALL SEND LDA SECTNO CMA CALL SEND RET ;sr delay the no of ms (roughly) in nulno nulsend: lda nulno nuls2: dcr a rm push psw push b lda fastclk ani 80h mov b,a nuls3: dcr b jnz nuls3 pop b pop psw jmp nuls2 ; 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: 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 JMP JMP$INITMOD ;RETURN DONE FROM THIS ROUTINE.. ; 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 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 modem 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: ;Setup routine for Sorcerer UART mvi a,0ffh call out$modctl2 call 0e1a2h ;getiy lda baudbyt db 0fdh,77h,45h ;=ld (iy+45h),a call out$baudrp RET ; 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 ; DISCONNT: ;Insert your code here to hangup up a direct ; connect modem if you needed 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 cpi 'H' ;new h command inserted rz CPI 'C' RZ 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 RET ; SAVAGN: MVI A,FALSE STA NFILFLG RET ; 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: mvi a,0ffh sta echfl+haven-rcan ;handover echo flag restored if nec 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 DB 'DSC - Disconnect',CR,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 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 db 'H - Hand over to remote computer',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: CALL ILCOMP ;DE SET FROM 1ST ILCOMP CALL DB 'DSC',0 ; JNC DISCON1 CALL ILCOMP DB 'WRT',0 ; JNC WRTFIL CALL ILCOMP DB 'XPR',0 ; JNC XPRMODE CALL ILCOMP DB 'DEL',0 ; JNC NEWFILE 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: 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 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 5, 'S', 'R', 'T', 'E', 'H' ;handover instn added 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: 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: 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 ; 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 ;Handover routines follow ;sr sets up handover on h instn rgiv: call qhando ;rets z if handed over already jz menu ;if so lxi h,rcan ;will relocate prog from rcan onwards lxi d,haven ;put it here mvi b,0 ;to move 100h call move lda 101h ;byte to check valid on exit mov l,a lda rgiv ;and another mov h,a shld chbyts+haven-rcan ;keep them here lhld base+1 ;bios+3 lxi d,4 ;will switch jp table addresses dad d ;const jp adr location lxi b,cstrt+haven-rcan ;to switch with const jp adr mov e,m mov m,c inx h mov d,m mov m,b xchg shld constx+haven-rcan ;conin jp adr kept xchg ;so we can replace inx h inx h ;conin jp adr location lxi b,cinrt+haven-rcan ;to switch mov e,m mov m,c inx h mov d,m mov m,b xchg shld coninx+haven-rcan ;conin jp adr kept xchg inx h inx h ;conout jp adr location lxi b,coutrt+haven-rcan ;to switch mov e,m mov m,c inx h mov d,m mov m,b xchg shld conotx+haven-rcan ;conout jp adr kept call ilprt db 0dh,0ah,'Handing over',0 ;msg will now be sent to modem too jmp xprt ;set up finished, back to command level ;sr ret z if handed over qhando: push b push h mov b,a lxi h,cstrt+haven-rcan mov a,h ;hibyte of cstrt adr lhld 1 mvi l,8 ;adr of const jp hibyte cmp m ;has cstrt adr been loaded? mov a,b pop h pop b ret ;The remainder is relocated at HAVEN so that ;the main program can be overwritten without a crash ;All adr refs to it have the offset HAVEN-RCAN added to them ;sr cancel handover rcan: lhld base+1 ;bios+3 lxi d,4 dad d ;const jp adr location xchg lhld constx+haven-rcan ;orig value stored here xchg mov m,e ;put it back inx h mov m,d inx h inx h ;conin jp adr location xchg lhld coninx+haven-rcan xchg mov m,e inx h mov m,d inx h inx h ;conout jp adr location xchg lhld conotx+haven-rcan xchg mov m,e inx h mov m,d lhld chbyts+haven-rcan ;now see if modem7 prog overwritten lda 101h cmp l jnz base ;if so go to cpm warm boot lda rgiv ;the other checkbyte cmp h jnz base lxi sp,stack jmp menu ;otherwise back to modem7 ;replaces const cstrt: lxi h,cst2+haven-rcan push h ;retadr lhld constx+haven-rcan pchl ;=call const cst2: ora a jz cst3a+haven-rcan ;jp if no key lxi h,cst3+haven-rcan push h ;retadr lhld coninx+haven-rcan pchl ;=call conin cst3: cpi eschar ;escape from handover? jz rcan+haven-rcan sta xbuf+haven-rcan ;or keep char jmp cst4+haven-rcan cst3a: lda xbuf+haven-rcan ora a jz cst5+haven-rcan cst4: mvi a,0ffh ;indicate ready ret cst5: call minst+haven-rcan ;ready to receive? jz cst4+haven-rcan ;jp if yes xra a ;no char ret ;replaces conin cinrt: call cstrt+haven-rcan ;also handles esc ora a jz cinrt+haven-rcan ;loop till ready lxi h,xbuf+haven-rcan ;see if key char mov a,m mvi m,0 ;null the buf anyway ora a rnz ;finished if it wasn't null call min+haven-rcan ;else must be modem inp cpi ' ' rc ;finished if null or actual control cpi '^' ;will it be ctrl seq? mvi b,1fh ;ctrl mask jz cin2+haven-rcan mvi b,7fh ;or null mask cin2: lxi h,ctrlfl+haven-rcan ;adr of ctrl mask ana m ;use it mov m,b ;and update it ret ;masked char in a ;replaces conout coutrt: push b call cstrt+haven-rcan ;handles esc pop b push b lxi h,cout2+haven-rcan push h ;retadr lhld conotx+haven-rcan pchl ;=call conout cout2: pop b lda echfl+haven-rcan ;echo flag ora a rz ;no echo unless set push b call coutm+haven-rcan ;send echo pop b mov a,c sui 0ah rnz mov c,a ;null to send lda lfnulls ;no of nulls to send mov b,a dcr b cout3: jm cout4+haven-rcan call coutm+haven-rcan dcr b jmp cout3+haven-rcan cout4: mvi c,'/' ;first char of line on rem scr coutm: call moust+haven-rcan ;ready to send? jnz coutm+haven-rcan ;if not, loop mov a,c jmp mout+haven-rcan ;send ;sr ret z if modem inp ready minst: in mstatp cma ani 2 ret ;sr ret z if modem outp ready moust: in mstatp cma ani 1 ret ;sr inp from modem min: in mdatp ret ;sr outp to modem mout: out mdatp ret constx: dw 0 ;to keep const jp adr coninx: dw 0 ;ditto conin conotx: dw 0 ;ditto conout xbuf: db 0 ;key char buffer chbyts: dw 0 ;bytes stashed to check for overwriting ctrlfl: db 7fh ;ctrl mask, changed to 1f following '^' echfl: db 0ffh ;echo flag, zeroed during file transfer lfnulls: db 3 ;after lf sent to remote computer DBUF DS 16*128 ;16 SECTOR DISK BUFFER NAMEBUF DS 1 ;BUFFER FOR NAMES IN BATCH MODE. OVERFLOWS.. ;..ABOVE PROGRAM CODE. LAST: END start