* Date: 1987 Sep 28 22:51 EDT * From: (John F. Chandler) PEPMNT@CFAAMP.BITNET * * ROVKERM v. 1.2 - KERMIT for the HP2647A terminal * @@1 EQU TIMER ; On/off switch for timer. @@2 EQU IBM ; On/off switch for IBM wait. * ORG 400Q RAMDSK EQU * ; START OF 32K 'RAM DISK' ORG 100400Q ; 256 EXTRA OVERLAP ASCC 'UKERMIT '255255'',- JMP IN ; ENTRY VECTOR ... JMP RTRN JMP IN XRA A RET NOP JMP RTRN JMP RTRN JMP RTRN EJECT * A FEW ASCII CHARS BEL EQU 7 BL EQU 32 BS EQU 8 CR EQU 13 DEL EQU 127 ESC EQU 27 LF EQU 10 XON EQU 17 KRET EQU 357Q ; KEYBOARD CODE FOR RETURN * EMSGLN EQU 3 ; SCREEN LINE FOR HOST ERROR FIDLN EQU 4 ; FILE NAME RCNOLN EQU 5 ; RECORD COUNT RTRYLN EQU 6 ; RETRY COUNT MSGLN EQU 7 ; VARIOUS MESSAGES TABCOL EQU 12 ; COMMON TAB COLUMN * * SYSTEM ENTRY POINTS SYSCPY EQU 100Q ; COPY (C) FROM (HL) TO (DE) CALROM EQU 106Q ; CALL ROM CODE AT (STACK) * CURPHD EQU 144Q ; HOME DOWN CURSOR CLEARL EQU 155Q ; CLEAR LINE FROM CURSOR CLEARS EQU 160Q ; CLEAR DISPLAY FROM CURSOR XPUTDC EQU 174Q ; XMIT CHAR TO DCM FROM (A) CHINT0 EQU 202Q ; DISPLAY CHARACTER FROM (C) MLKOF0 EQU 232Q ; TURN ON MEM LOCK AT (177553) BN2DEC EQU 250Q ; CONVERT TO DECIMAL $WINDW EQU 352Q ; DISPLAY WINDOW IN (B) $KBFNC EQU 402Q ; DISPLAY CHAR OR FUNCTION IN (C) $KBPRC EQU 410Q ; UPDATE KEYBOARD STATE $CURPLC EQU 413Q ; CLEAN UP DISPLAY/CURSOR GTKEY EQU 64005Q ; GET KEY CODE, IF ANY BELL EQU 64024Q ; RING BELL GETDC EQU 70030Q ; GET CHAR FROM DCM, IF ANY * FILE SYSTEM $INOPN EQU 422Q ; OPEN FILE FOR INPUT $CLOSE EQU 425Q ; CLOSE FILE $OUTOPN EQU 430Q ; OPEN FOR OUTPUT $READ EQU 433Q ; GET RECORD $WRITE EQU 436Q ; PUT RECORD $CNTRL EQU 441Q ; PERFORM CONTROL OPERATION * SYSTEM VARIABLES DCMIP EQU 175673Q ; DCM RING BUFFER INPUT POINTER DCMOP EQU 175675Q ; DCM RING BUFFER OUTPUT POINTER KBSTT EQU 175762Q ; KEYBOARD STATE FBPTR EQU 176136Q ; SYSTEM PTR TO CURRENT FB DECBUF EQU 177011Q ; TEMP BUFFER LOKROW EQU 177553Q ; SCREEN ROW TO LOCK FREPTR EQU 177613Q ; PTR TO FREE MEMORY CRSPOS EQU 177700Q ; CURSOR POSITION EJECT * INITIALIZE PROGRAM IN POP H ; SAVE RETURN ADDRESS SHLD RETAD+1 LHLD FREPTR ; STACK AREA LXI D,-257 DAD D SHLD OUTFBB ; GET BUFFER SHLD TMPFBB SHLD RSTSP+1 ; FOR QUITTING SPHL MVI B,4 ; DSPLY IN WINDOW 4 CALL SWNDW XRA A STA STYPE MVI A,MSGLN+1 STA LOKROW LXI H,MLKOF0 ; LOCK SCREEN PUSH H RST 2 CALL CRS00 ; SCREEN HOME LXI H,CLEARS ; CLEAR ALL PUSH H RST 2 CALL PSTRLOC ASCC 'Rover Kermit 1.2' ; UPDATE AS VERSION CHANGES LXI H,0:40 CALL PCRS ASCC 'Send, Receive, Get, Quit, Finish, Logout' LXI H,1:40 CALL PCRS ASCC 'Core, Tape, Kermit, Parm' CALL DEVFLG CALL INDIC ; DISPLAY FLAGS LXI H,RCNOLN:TABCOL-8 CALL PCRS ASCC 'Record:' LXI H,RTRYLN:TABCOL-9 CALL PCRS ASCC 'Retries:' EJECT * COMAND LOOP WAITING MVI A,1 STA BLOCK ; RESTORE USUAL BLOCK CHECK CALL WAITU ; GET CHAR STA CMTBZ LXI H,CMTBL CALL CMDSP ; FIND AND CALL COMMAND ROUTINE JMP WAITING ; RESUME * * COMMAND TABLE CMTBL DB CHAR C DW CORE ; TO/FROM MEMORY DB CHAR E DW EXIT DB CHAR F DW UNSRV ; FINISH DB CHAR G DW GET DB CHAR K DW KERMCMD DB CHAR L DW UNSRV ; LOGOUT DB CHAR P DW SET ; PARM DB CHAR Q DW EXIT DB CHAR R DW RECEIVE DB CHAR S DW SEND DB CHAR T DW TAPE ; TO/FROM TAPE DB 128+CHAR h DW FUNC ; HOME DB 128+CHAR F DW FUNC ; HOME DOWN DB 128+CHAR S DW FUNC ; ROLL UP DB 128+CHAR T DW FUNC ; ROLL DOWN DB 128+33Q DW FUNC ; COMMAND MODE CMTBZ DB 0 DW ERR1 ; NONE OF THE ABOVE * ERR1 CALL MSGBP ASCC 'Bad command' MSGBP CALL BEEPM MSGNO POP H ; PTR TO MESSAGE JMP PSTR * * PERFORM SCREEN FUNCTION FUNC MOV C,A LXI H,$KBFNC PUSH H RST 2 JMP WAITING EJECT * PERFORM SET FUNCTION SET CALL SCRSET ASCC 'Prm: oN, oFf, Chr, Val' CALL WAITU ; GET COMMAND LXI H,EMSGLN:5 CPI CHAR C ; CHAR? JZ SETCHR CPI CHAR V ; VALUE? JZ SETVAL MVI B,160Q ; MOV M,B CPI CHAR F ; OFF? JZ SETFLG INR B ; MOV M,C CPI CHAR N ; ON? JNZ ERR1 ; NONE OF THE ABOVE SETFLG MOV A,B STA STFL ; SET ON OR OFF CALL PCRS ; PROMPT FOR OPTION ASCC 'IBM, Timer, 8-bit' CALL WAITU LXI D,STBLZ LXI H,STBL CALL FLLK ; LOOK UP OPTION XCHG STFL MOV M,C ; OR MOV M,B JMP INDIC ; DISPLAY LATEST SETTINGS * SETVAL CALL PCRS ; PROMPT FOR OPTION ASCC 'Bufsz, Hndshk, Mark, Retry, Time' CALL GETNUM PUSH H LXI D,SNTBLZ LXI H,SNTBL CALL FLLK ; LOOK UP OPTION POP H ; RETRIEVE VALUE MOV A,L CMP C JC ERR1 ; TOO SMALL CMP B JNC ERR1 ; TOO BIG STAX D ; SET NEW VALUE JMP INDIC ; DISPLAY LATEST SETTINGS * SETCHR CALL PCRS ; PROMPT FOR OPTION ASCC 'Src, Dest, Quote, Rept, 8-bit, Blk-chk' CALL WAITU LXI D,SCTBLZ LXI H,SCTBL CALL FLLK ; LOOK UP OPTION PUSH B CALL WAITU POP H MOV C,M ; USE OLD VALUE AS 'DEFAULT' XCHG RST 1 ; CALL CHECKER STAX D ; STORE NEW VALUE JMP INDIC ; DISPLAY LATEST SETTINGS EJECT * OPTION LOOK-UP FLLK PUSH D ; SAVE END OF TABLE STAX D ; MARK LAST ITEM FLLP CMP M ; FOUND? INX H MOV E,M ; GET ADR INX H MOV D,M INX H MOV C,M ; GET DATA INX H MOV B,M INX H JNZ FLLP ; NOT FOUND YET MOV A,L ; SAVE ITEM PTR POP H ; RETRIEVE PTR TO END OF LIST SUB L POP H ; GRAB RETURN ADR DCR A JP ERR1 ; RAN OFF END PCHL ; OK * * TABLE OF ON/OFF SWITCHES STBL DB CHAR I ; IBM DW IBM,INSTR CALL:INSTR LXI DB CHAR T ; TIMER DW TIMER,INSTR JZ:INSTR JC DB CHAR 8 ; 8-BIT DW SQU8,CHAR Y:CHAR N STBLZ DB 0 * TABLE OF CHARACTER OPTIONS: CHECK ROUTINE, LOCATION SCTBL DB CHAR S ; SOURCE DW UPPER,LNAME DB CHAR D ; DESTINATION DW UPPER,RNAME DB CHAR Q ; QUOTE DW CKQC,QUOTE DB CHAR R ; REPEAT DW CKQC,DPTQ DB CHAR 8 ; 8-BIT DW CKQC,SQU8 DB CHAR B ; BLOCK-CHECK DW CKBKC,BKTP SCTBLZ DB 0 * TABLE OF VALUE OPTIONS: LOCATION, MIN:MAX+1 SNTBL DB CHAR B ; BUFFER SIZE DW BUFSZ,20:95 DB CHAR H ; HANDSHAKE CODE DW HNDSHK,0:BL DB CHAR M ; MARK DW MARK,0:BL DB CHAR R ; RETRY DW RETRY,1:200 DB CHAR T ; TIME-OUT DW TIME,1:95 SNTBLZ DB 0 EJECT * RESET DIALOG SCRSET LXI H,$KBPRC PUSH H RST 2 ; UPDATE STATE LXI H,0 SHLD RECCT+1 CALL PRTRY XRA A STA CXZ+1 ; CLEAR INTERRUPT FLAG MVI A,XON STA XFLEN ; ASSUME QUICK TRANSFER LDA STYPE ORA A CNZ DCMFLH ; FLUSH BUFFER MVI A,BL ; PACKET NUMBER STA SSEQ MVI A,CHAR N STA SNDFL+1 ; NOTHING SENT YET MVI A,INSTR LXI STA SPSND ; DISABLE LXI H,EMSGLN:0 CALL CLRLH POP H CALL PSTR ; SHOW CMD NAME PUSH H SCRBOT LXI H,CURPHD ; HOME DOWN PUSH H RST 2 RET * FLUSH DCM BUFFER DCMFLH LDA IBM CPI INSTR CALL RZ ; IBM'S DON'T TYPE AHEAD DI LHLD DCMIP SHLD DCMOP ; RESET BUFFER PTRS EI RET * * STORAGE IN MEMORY CORE LXI H,RAMOUT LXI D,RAMIN LXI B,STAR+6 SETDEV SHLD RCVSET+1 XCHG SHLD SNDSET+1 MOV H,B ; COPY PTR TO MARKER STRING MOV L,C SHLD DEVFM+1 DEVFLG CALL CRS00 ; MOVE CURSOR AWAY ... LXI H,2:40 CALL SETCRS ; AND BACK DEVFM LXI H,STAR JMP PSTR ; MARK CURRENT SOURCE * STORAGE ON TAPE TAPE LXI H,TAPOUT LXI D,TAPIN LXI B,STAR JMP SETDEV STAR ASCC ' * ' EJECT * RECEIVE A FILE RECEIVE CALL SCRSET ; CLEAR RETRY COUNT, ETC ASCC 'Rcv' RCV1 LXI H,RCVSTI ; SET UP INITIAL WAIT STATE CALL VERIFYP ; GET GOOD PACKET RCV2 CALL GETPRM ; VALIDATE PARMS CMP C ; REPEAT PRFX = QUOTE? JNZ *+5 ; NO, THEN USE IT MVI A,BL ; FORBID STA SPTQ ; FOR ACK MOV A,C STA SQUO LXI H,SNITP ; ACK DATA MVI C,SNITL ; LENGTH MVI A,CHAR Y CALL SPACK ; DO IT CALL BUMPNO LDA BCTN+1 ; NEGOTIATED BLOCK CHECK STA BLOCK ; NOW USE IT RHEDR LXI H,RCVSTH ; EXPECT FILE HEADER CALL VERIFYP ; GET GOOD PACKET LXI H,BUFOUT LXI D,FILMS2 MVI A,LFILM2 CALL SETDCD CALL DECODE MVI M,0 ; MARK END MOV A,L SUI FILMS2>400Q ; GET LENGTH OF NAME STA FNMLT+1 LXI H,FIDLN:TABCOL-6 CALL CLRLH LXI H,FILMSG ; File: ... CALL PSTR CALL SCRBOT RCVSET LXI H,TAPOUT LDA RTYPE CPI CHAR X JNZ *+6 LXI H,SCRNOUT ; TEXT HEADER: DISPLAY CALL SETDCDX LXI H,RCVSTD ; NOW EXPECT DATA PACKETS SHLD VERPTR+1 RDATA CALL ACK0 ; SEND ACK CALL VERIFY ; WAIT FOR NEXT CALL DECODE ; DECODE FROM PACKET JMP RDATA ; ACK AND WAIT RCVEOF STC CALL DCDOPR ; HANDLE END CALL ACK0 JMP RHEDR ; WAIT FOR ANOTHER FILE RCVBRK CALL ACK0 ; DONE RECEIVING RCVOK LDA CXZ+1 ; HALT? DCR A JP RCVDIE ; YES CALL MSGNO XFLEN ASCC ' Transfer done' ; START WITH BEEP OR XON RCVDIE CALL MSGBP ASCC 'Transfer halted' EJECT * SEND ARBITRARY COMMAND KERMCMD CALL SCRSET ASCC 'Cmd' CALL PMSG ASCC 'Enter command' CALL WAITU ; GET TYPE CALL RDST ; GET STRING RZ CALL ENCSTR ; ENCODE AND SEND IT LXI H,CMDST ; EXPECT ACK OR LONG REPLY CALL VERIFYP DCX H MOV A,M ; SEE IF 'SHORT REPLY' ORA A RZ CALL SCRBOT LXI H,RDAT JMP PSTR ; JUST DISPLAY IT * * GET A FILE FROM KERMIT SERVER GET CALL SCRSET ASCC 'Get' MVI A,CHAR R ; RECEIVE INIT CALL RDFNT JZ *-5 ; INSIST CALL ENCSTR ; ENCODE AND SEND NAME JMP RCV1 ; NOW RECEIVE IT * * ISSUE SERVER COMMAND UNSRV CPI CHAR L ; LOGOUT? JNZ UNSRV2 ; NO, JUST DO IT CALL BEEPM ; YES, GET CONFIRMATION CALL PSTRLOC ASCC 'Logout? (Y|N) ' CALL WAITU CPI CHAR Y JNZ ERR1 ; NOT CONFIRMED: GOOF UNSRV2 CALL SCRSET ASCC 'Cmd' LXI H,STYPE MVI M,CHAR G ; 'GENERIC' INX H LDA CMTBZ ; TYPED COMMAND MOV M,A MVI B,1 ; 1 BYTE OF DATA CALL SPACKC ; SEND IT JMP EXIT EJECT * GET FILE NAME AND SEND RDFNT PUSH PSW ; PACKET TYPE CALL PMSG ASCC 'Enter file name' POP PSW RDST STA STYPE ; SAVE PACKET TYPE LXI H,BUF ; PUT STRING HERE MOV E,L ; SAVE START OF DATA MVI A,CHAR : RDVLP CALL WCHAR RDVL2 PUSH H CALL WAITU ; GET CHAR POP H CPI CR ; RET? JZ RDVZ ; DONE CPI DEL JZ RDVBS ; TREAT DEL AS BS JNC RDVL2 ; FUNCTION KEY CPI BS JNZ RDVX ; ORD. CHAR RDVBS MOV A,L ; MUST BACK UP CMP E ; EMPTY? JZ RDVL2 ; YES, READ MORE DCX H MVI A,BS ; AND BACK UP CURSOR JMP RDVLP RDVX CPI BL ; CTL? JC RDVL2 ; IGNORE MOV M,A ; ADD TO BUFFER INX H JMP RDVLP RDVZ MOV A,L SUB E ; GET LENGTH RZ MVI M,0 ; MARK END OF STRING PUSH PSW ; SAVE LENGTH CALL SCRBOT LXI H,BUF ; STRING STARTS HERE POP PSW ORA A ; RETURN 'NZ' RTRN RET EJECT * SEND A FILE FROM CURRENT POSITION ON TAPE SEND CALL SCRSET ASCC 'Snd' MVI A,INSTR LXI+20Q STA EOFFL MVI A,CHAR S LXI H,SNITP ; INIT PACKET MVI C,SNITL CALL SPACK ; SEND IT LXI H,SNDST ; EXPECT ACK'S CALL VERIFYP CALL GETPRM ; ANALYZE RESPONSE LXI H,SPTQ ; MY SUGGESTION CMP M ; AGREES? JZ *+7 ; YES, USE IT MOV A,C ; NO, SUPPRESS REPEATS STA RPTQ LDA SQUO CMP C ; MUST MATCH CNZ ERAK ; BAD ACKNOWLEDGE CALL BUMPNO ; COUNT PACKETS BCTN MVI A,1 ; USUAL BLOCK CHECK STA BLOCK MVI A,CHAR F CALL RDFNT ; GET FILE NAME, IF ANY JNZ SNDNM ; GOT NAME PTRS LDA SNDSET+1 CPI RAMIN>400Q ; FROM RAM? LDA FNMLEN LXI H,FNM JZ SNDNM ; YES, THEN ALREADY GOT NAME LXI H,SFN ; NO, USE DUMMY MVI A,SFNL SNDNM CALL ENCSTR ; ENCODE AND SEND NAME LXI H,FIDLN:TABCOL CALL SETCRS ; SET CURSOR LHLD SVBFP+1 CALL PSTR ; DISPLAY FILE NAME CALL SCRBOT CALL VERIFY MVI A,CHAR D ; NOW SEND DATA STA STYPE SNDSET LXI H,TAPIN CALL SETDCD XRA A STA SVBFL+1 ; NO SAVED DATA CALL BUMPNO * MAIN SEND LOOP SLOOP CALL MAKPAK ; SEND A PACKET FROM INPUT CALL VERIFY ; WAIT FOR ACK CALL BUMPNO LDA STYPE ; CHECK FOR EOF CPI CHAR D JZ SLOOP ; NO, STILL SENDING DATA MVI A,CHAR B ; BREAK CONNECT CALL SPACK0 CALL VERIFY ; WAIT FOR ACK JMP RCVOK ; DONE, SHOW MSG EJECT * ENCODE STRING AT (HL) OF LENGTH (A), AND SEND IT ENCSTR MVI B,0 ; JUST IN CASE ORA A ; ANYTHING IN STRING? JZ SPACKC ; NO, JUST SEND (TYPE ALREADY SET UP) SHLD SVBFP+1 ; SAVE PTRS STA SVBFL+1 * ENCODE DATA FOR SENDING MAKPAK MVI A,INSTR CNZ STA MAKEOF CXZ MVI A,0 ; INTERRUPT? DCR A JP DISC ; YES, DISCARD SVBFP LXI H,0-0 ; SAVED INPUT PTR SVBFL MVI A,0-0 ; AND LENGTH REMAINING LXI D,SDAT ; OUTPUT BUFFER PUSH D RBSIZ EQU *+1 ; MAX ALLOWED SEND MVI B,92 MAKPL ORA A JNZ MAKPA1 ; USE IT EOFFL JMP MAKPZ ; OR LXI D PUSH B INR A ; SET 'NZ' CALL DCDOPR POP B JNC MAKPA1 MVI A,INSTR JMP ; HIT EOF STA EOFFL XRA A JMP FUL1 ; SEND LAST PACKET MAKPA1 MOV C,A ; SAVE LENGTH RQUO EQU *+1 ; QUOTE CHAR (E) RQU8 EQU *+2 ; 8-BIT QUOTE (D) LXI D,CHAR #:CHAR & MVI A,INSTR JNZ ; DATA FOUND THIS BUFFER STA MAKEOF MOV A,M ; GET NEXT BYTE INX H CMP M ; AT LEAST 2? DCX H JNZ RPTZ ; NO, FORGET IT LDA RPTQ ; DOING REPEATS? CMP E JZ RPTZ ; OFF IF SAME AS QUOTE MOV A,B ; CHECK OUTPUT BUFFER CPI 5 JC RPTZ ; NO ROOM MOV A,C ; CHECK DATA LENGTH ORA A ; 256? JZ SLP2 ; YES, LONG CPI 4 JC RPTZ ; NOT WORTH IT SLP2 PUSH B ; SAVE CURRENT COUNT MVI A,94 ; MAX RPT COUNT INR C DCR C JZ SLIM ; 256 CMP C JNC *+4 SLIM MOV C,A PUSH B MOV A,M ; GET CHAR AGAIN RPTL INX H DCR C JZ RPTX ; END, TALLY UP CMP M ; STILL MATCHING? JZ RPTL RPTX XTHL ; GET OLD # MOV A,C SUB L ; -(REPEAT COUNT) POP H XTHL ; STARTING COUNT CPI -3 ; WORTH IT? JC RPTY ; YES, DO IT MOV C,L ; NO, RESTORE PTRS POP H ADD L ; BACK UP BUFFER PTR TO 1ST MOV L,A JC *+4 DCR H JMP RPTZ ; GIVE UP RPTY STA MRPTC+1 ; SAVE -(COUNT) ADD L ; CORRECT FINAL COUNTER MOV C,A INR C POP H ; -> 1ST NON-MATCH DCX H ; LAST MATCH XTHL ; GET OUTPUT PTR LDA RPTQ ; GET REPEAT PRFX MOV M,A ; ADD TO BUFFER INX H DCR B MVI A,BL MRPTC SUI 0-0 ; GET CHAR(COUNT) MOV M,A INX H DCR B XTHL ; BACK TO INPUT RPTZ MOV A,D ; GET 8-BIT QUOTE CMP E ; SAME AS QUOTE? MOV A,M ; GET DATA CHAR XTHL JZ TCHR ; NO 8-BIT QUOTING ORA A JP TCHR ; 8TH BIT OFF DCR B ; SEE IF ROOM JZ FULL ; NO, CLOSE PACKET NOW DCR B ; MIGHT NEED 3 JZ FULL INR B MOV M,D ; INSERT QUOTE INX H ANI 177Q TCHR CMP E ; QUOTE? JZ SPECL ; YES, SPECIAL CHAR CMP D ; 8-BIT QUOTE? JZ SPECL RPTQ EQU *+1 CPI CHAR ~ ; REPEAT PRFX? JZ SPECL CPI DEL JZ SPECX CPI BL JNC ADDIT ; NORMAL CHAR SPECX XRI 100Q ; DECONTROLLIFY SPECL DCR B ; SEE IF ROOM JZ FULL ; NO, CLOSE OUT MOV M,E ; YES, ADD QUOTE INX H ADDIT MOV M,A ; ADD CHAR TO BUFFER INX H XTHL ; INPUT PTR INX H ; USED IT DCR C DCR B ; COUNT OUTPUT MOV A,C JZ FUL1 ; FILLED BUFFER ORA A ; ANY MORE DATA? JNZ MAKPL ; YES, KEEP GOING LDA STYPE CPI CHAR D ; SENDING FILE? JNZ FUL2 ; NO, ASSUME JUST A STRING MOV A,B CPI 3 ; MUCH ROOM? MOV A,C JNC MAKPL ; ENOUGH ANYWAY JMP FUL1 ; NO, SEND IT OFF FULL MOV A,C ; REMAINING COUNT XTHL FUL1 CALL SVBFS ; SAVE PTR TO DATA FUL2 POP H ; OUTPUT PTR MOV A,L SUI SDAT>400Q ; LENGTH MOV B,A ; SET UP FOR SPACK MAKEOF JNZ SPACKC ; OR 'CNZ' MAKPY PUSH H * REACHED EOF MAKPZ MVI A,CHAR Z ; SEND EOF POP D ; FLUSH OUTPUT PTR JMP SPACK0 * DISC STC ; SIGNAL 'EOF' CALL DCDOPR JMP MAKPY EJECT * INPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN, * 'NZ,NC' => READ, 'C' => CLOSE * ON EXIT: 'NC' => (HL)->BUFFER, (A)=LENGTH (MOD 256) * 'C' => REACHED EOF * * TAPE INPUT TAPIN JC RDTEOF JNZ RDTAP XRA A STA TMPFB+3 LXI H,$INOPN LXI D,TMPFB CALL FSYS ; OPEN TAPE CNZ ERWR ; GIVE UP RET ; OK RDTAP XRA A STA TMPFBC ; BUFFER LENGTH LXI D,TMPFB LXI H,$READ ; READ OPR CALL FSYS JNZ RDTEOF ; ASSUME EOF LDA TMPFBC ; BYTE COUNT LHLD TMPFBB ; BUFFER RET RDTEOF CPI 3 CNC ERIO ; TAPE ERROR LXI D,TMPFB CALL FBRLSE ; FREE TAPE STC RET * * INPUT FROM CORE RAMIN RC JNZ RDRAM LHLD RAMD0 ; START OF FILE RDRAM SHLD SVBFP+1 PUSH D RAMZ LXI D,RAMDSK ; END OF FILE MOV A,E SUB L ; AMOUNT LEFT MOV L,A MOV A,D SBB H MOV H,A POP D RC ; PAST END?? ORA L ; ANY? STC RZ ; NONE, RETURN EOF ORA A ; CLEAR 'C' INR H ; AT LEAST 256? DCR H LHLD SVBFP+1 ; RETRIEVE CURRENT PTR RZ ; LITTLE LEFT XRA A ; LOTS LEFT RET EJECT * SEND A PACKET SPACK0 MVI C,0 * SEND A PACKET - ENTER HERE WITH (HL)->DATA, (C)=LENGTH, (A)=TYPE SPACK LXI D,STYPE STAX D ; SAVE TYPE INX D MOV B,C ; SAVE LENGTH INR C DCR C ; ANY DATA? CNZ SYSCPY ; YES, COPY IT * HERE (B)=DATA LENGTH, BUFFER CONTAINS TYPE+DATA SPACKC LDA MARK LXI H,SPAKT MOV M,A ; SET SYNCH MARK INX H CALL SPINT INR B INR B ; COUNT SEQ,TYPE IN CHECKSUM LDA BLOCK ; INCLUDE CHECK IN PACKET LENGTH ADD B ADI BL ; GET CHAR(LEN) MOV M,A MVI C,0 ; CLEAR HIGH BYTE OF CHECK SPCHKL INX H ADD M ; TALLY SUM JNC *+4 INR C ; BUMP HIGH BYTE DCR B JNZ SPCHKL INX H ; PTR TO CHECK XCHG ; SAVE PTR CALL CHEK1 ; CONVERT TO 1-BYTE OR 2-BYTE CHECK XCHG MOV M,A ; SAVE IN BUFFER INX H LDA BLOCK STA SNDFL+1 ; INDICATE SOMETHING SENT DCR A JZ *+5 ; JUST ONE BYTE MOV M,C ; SAVE OTHER BYTE INX H REOL EQU *+1 ; HIS END-OF-LINE MVI M,CR ; OR WHATEVER INX H MVI M,0 ; END WITH NULL SPSND CALL RWAIT ; OR LXI - WAIT FOR XON LXI D,SPAKT ; WHOLE PACKET SPSLP LDAX D INX D ORA A RZ LXI H,XPUTDC ; XMIT CHAR PUSH H RST 2 JMP SPSLP ; UP TO NULL EJECT * COMPUTE CHECK FROM (A) OR (A:C), CLOBBERS H,L,C CHEK1 MOV L,A ; LOW BYTE OF NUMBER MOV H,C ; HIGH BYTE MOV C,A LDA BLOCK DCR A ; ONE OR TWO? JNZ CHEK2 MOV H,C DAD H ; SHIFT 2 BITS RAL DAD H RAL ADD C CHEKR ANI 77Q ADI BL ; GET CHAR(CHECK) RET CHEK2 DAD H ; COMPUTE 2-BYTE CHECK FROM (HL) DAD H MOV A,C ; FRESH COPY OF LOW BYTE ANI 77Q ADI BL ; GET CHAR(LO-CHECK) MOV C,A ; IN (C) MOV A,H JMP CHEKR ; AND CHAR(LO-CHECK) * * CHECK INTERRUPTS SPINT LDA CXZ+1 DCR A RM ; OK MOV C,A LDA STYPE CPI CHAR Y JZ SPINT1 ; MAKING AN ACK MVI C,CHAR D-CHAR X CPI CHAR Z JZ SPINT1 ; MAKING AN EOF CPI CHAR D RNZ MVI B,0 ; MAKING DATA MVI A,CHAR Z ; CHANGE TO EOF STA STYPE SPINT1 MOV A,C ; FLAG FOR X,Z,D DCR B INR B RNZ ; ALREADY HAD THIS STUFF INR B ; MUST ADD A BYTE FOR REJECTION ADI CHAR X STA SDAT RET EJECT * WAIT FOR XON FROM HOST RWAIT LXI H,RTRN ; TIMEOUT EXIT CALL TIMSET RWT1 CALL GCH ; GET CHAR CPI ESC JZ RWT2 ; SUPPRESS ESCAPES PUSH PSW CALL WCHAR ; ECHO EVERYTHING POP PSW HNDSHK EQU *+1 RWT2 CPI XON JNZ RWT1 ; KEEP WAITING RET * * SET TIMEOUT EXIT TIMSET SHLD GCHTX+1 IBM EQU *+1 MVI A,INSTR CALL ; OR LXI STA SPSND RET EJECT * RECEIVE A PACKET RPACK PUSH D LXI H,RPBAK ; TIMEOUT EXIT CALL TIMSET RP1 CALL GCH ; GET A CHAR JZ RBEG ; FOUND MARK CHAR CALL WCHAR JMP RP1 RBEG CALL GCH ; GET LENGTH CHAR JZ RBEG ; ANOTHER MARK MVI D,0 ; CLEAR HIGH BYTE OF SUM MOV C,A ; INIT LOW BYTE BLOCK EQU *+1 SUI 1 JM RPRET ; IMPOSSIBLE!? SUI 42Q ; MIN VALUE JC RPRET ; IMPOSSIBLE STA RLEN ; DATA LENGTH MOV B,A INR B ; ALSO COUNT SEQ,TYPE INR B LXI H,BUF RLP CALL GCH JZ RBEG ; START OVER CPI BL ; CTL? JC RPRET ; NOT ALLOWED MOV M,A ; ADD TO BUFFER ADD C ; KEEP SUM MOV C,A JNC *+4 INR D ; PROPAGATE CARRY INX H DCR B JNZ RLP MVI M,0 ; END OF PACKET MOV C,D CALL CHEK1 ; DONE, GET CHECK MOV D,A ; SAVE LOW BYTE CALL GCH ; GET CHECK FOR PACKET JZ RBEG ; I DON'T BELIEVE IT CMP D ; MATCH? JNZ RPRET ; TOO BAD LDA BLOCK DCR A JZ RPRET ; 1-BYTE, OK (CC='Z') CALL GCH ; GET CHECK FOR PACKET JZ RBEG ; I DON'T BELIEVE IT CMP C ; MATCH? RPRET MVI A,CHAR N ; INDICATE BAD PACKET RPBAK LXI H,RTYPE ; PTR ON RETURN POP D ; RESTORE RZ ; OK MOV M,A ; ERROR RET EJECT * DECODE INFO DECODE LXI H,RDAT ; DATA PTR LDA RLEN ; DATA LENGTH ORA A ; ANY? MOV C,A LDA SVBFL+1 ; ROOM FOR OUTPUT MOV B,A XCHG LHLD SVBFP+1 ; OUTPUT PTR RZ ; NO DATA PUSH H LHLD RQUO ; GET QUOTE, 8-BIT XCHG * (HL)->INPUT, (C)=INPUT LENGTH, (B)=OUTPUT ROOM * (D)=8-BIT, (E)=QUOTE, OUTPUT PTR ON STACK DCDL LDA RPTQ ; RPT PRFX CALL TQCH ; SEE IF ANY MVI A,0 ; NO REPEATS JZ DCDR MOV A,M ; GET RPT COUNT SUI BL+1 ; CONVERT CC ERRP ; BAD COUNT CALL IINP ; GOBBLE DCDR STA RPTCT ; SAVE COUNT MOV A,D ; SEE IF 8-BIT CALL TQCH MVI A,200Q ; PARITY BIT IF SO JNZ *+4 XRA A ; NOT STA STPR+1 ; SAVE MOV A,E CALL TQCH1 ; SEE IF QUOTE MOV A,M JZ STPR ; NO, USE CHAR CMP E ; QUOTE-QUOTE? JZ STPR ; SPECIAL CHARS, OK CMP D JZ STPR LDA RPTQ CMP M JZ STPR MOV A,M XRI 100Q ; CONTROLLIFY STPR ORI 0-0 ; SET PARITY BIT XTHL ; GET OUTPUT PTR DCDO MOV M,A ; ADD TO OUTPUT INX H DCR B ; FULL? JZ DCDW ; YES, WRITE IT CPI LF ; CHECK FOR RECORDS JNZ DCDY ; NO PREV EQU *+1 ; PREVIOUS CHAR MVI A,0-0 CPI CR ; PRECEDED BY CR? MVI A,LF JNZ DCDY ; NO, OK * WRITE OUT DCDW PUSH PSW ; SAVE CURRENT CHAR ORI 1 ; SET CC='NZ,NC' CALL DCDOPR ; WRITE FULL BUFFER POP PSW DCDY STA PREV RPTCT EQU *+1 ; REPEAT COUNT MVI A,0-0 DCR A ; ANY MORE? JM DCDZ ; NO STA RPTCT ; KEEP COUNTING LDA PREV JMP DCDO ; DO IT AGAIN DCDZ XTHL INX H DCR C ; INPUT DONE? JNZ DCDL ; NO, KEEP COPYING POP H ; RECOVER OUTPUT PTR MOV A,B JMP SVBFS ; SAVE FOR NEXT TIME * * CHECK DATA FOR PREFIX IN (A). IF NOT, RETURN 'Z' * IF SO, GOBBLE CHAR AND RETURN 'NZ' TQCH CMP E ; SAME AS QUOTE? RZ ; NOT IN USE TQCH1 CMP M ; FOUND ONE? JNZ RETZ ; NO, RETURN IINP INX H ; ADVANCE INPUT PTR DCR C ; CHAR USED UP CZ ERQU ; BROKEN STRING RET RETZ XRA A ; SET 'Z' RET EJECT * FIRST RESET CXZ FLAG SETDCDX XRA A STA CXZ+1 * (HL)->ROUTINE, (DE)->BUFFER, (A)=LENGTH SETDCD SHLD DCDOPR+1 ; SET OUTPUT ROUTINE XCHG CMP A ; SET CC='Z' DCDOPR JMP 0-0 * * OUTPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN, * 'NZ,NC' => WRITE, 'Z,C' => DUMP+CLOSE (HL)->END+1 * ON EXIT, (HL)->BUFFER, (B)=LENGTH (MOD 256) * * OUTPUT TO TAPE TAPOUT JC TAPEOF JNZ WRTAP ; WRITE RECORD CALL FBSET ; OPEN OUTPUT CNZ ERWR ; NOT AVAILABLE TAPST1 LHLD OUTFBB ; TAPE BUFFER XRA A SVBFS SHLD SVBFP+1 ; OUTPUT PTR STA SVBFL+1 RET TAPEOF CALL BUFCHK ; DUMP BUFFER MVI A,1 ; SET FOR CTL STA OUTFB+3 MVI A,5 ; TAPE MARK STA OUTFBC+1 LXI H,$CNTRL ; CONTROL OPERATION CALL FSYSO LXI D,OUTFB JMP FBRLSE ; FREE TAPE * (HL)->END OF FILLED BUFFER, (B)=REMAINING ROOM WRTAP PUSH B ; WRITE TAPE RECORD PUSH D MOV A,L LHLD OUTFBB ; BUFFER PTR SUB L ; GET LENGTH STA OUTFBC LXI H,$WRITE ; WRITE ROUTINE CALL FSYSO ; DO IT CNZ ERIO ; TOO BAD POP D POP B WRTZ LHLD OUTFBB ; NEW OUTPUT PTR MVI B,0 RET EJECT * OUTPUT TO SHORT BUFFER BUFOUT JZ SVBFS ; SETUP - ADR,LEN IN HL,A POP D ; JUST RETURN WHEN FILLED POP D RET * * OUTPUT TO LONG CORE BUFFER RAMOUT JC RAMEOF JNZ WRTRAM ; WRITE RECORD LXI H,FILMS2 ; COPY FILE NAME+LENGTH LXI D,FNM MVI C,FNML FNMLT MVI A,1 ; SET BY INPUT CMP C JC *+4 MOV A,C ; MAX LENGTH STA FNMLEN CALL SYSCPY LHLD RAMD0 ; BIG BUFFER XRA A JMP SVBFS ; SET UP PTRS RAMEOF LHLD SVBFP+1 ; END OF DATA SHLD RAMZ+1 ; SAVE RET WRTRAM MVI B,0 ; ALLOW FULL 256 BUFFER INR H ; TEST FOR OVF DCR H RP ; OK CALL RAMEOF ; SAVE END PTR CALL ERIO * * OUTPUT TO SCREEN SCRNOUT JC BUFCHK JZ TAPST1 ; SET PTRS MVI M,0 ; MARK END LHLD OUTFBB CALL PSTR ; DISPLAY IT JMP WRTZ * DUMP BUFFER IF NOT EMPTY BUFCHK LDA SVBFL+1 ; ANYTHING IN BUFFER? LHLD SVBFP+1 ORA A JNZ DCDOPR ; YES, DUMP IT RET EJECT * ANALYZE INIT PARMS GETPRM LDA RLEN ; DATA LENGTH MOV B,A LXI H,RDAT CALL GETOP ; BUFFER LENGTH SUI BL JZ MAXBF ; DEFLT CPI 26 ; MIN JNC *+6 ; OK LDA *-4 ; USE MIN CPI 96 ; MAX JC *+6 ; OK MAXBF LDA *-4 ; USE MAX SUI 6 ; ENVELOPE: MARK,LEN,SEQ,TYPE + CHECK STA RBSIZ CALL GETOP ; TIME TIMER EQU *+1 MVI C,INSTR JZ SUI BL JNC *+6 XRA A ; DON'T MVI C,INSTR JC ; DISABLE TIMER ADD A ; X 4 JC MAXT ; TOO BIG ADD A JNC SAVT MAXT XRA A SAVT STA RTIM MOV A,C STA TIMER1 CALL GETOP ; SKIP NPAD CALL GETOP ; PAD CHAR CALL GETOP ; EOL SUI BL JZ DFLTEOL CPI BL ; MUST BE CONTROL JC *+5 ; OK DFLTEOL MVI A,CR STA REOL CALL GETOP ; QUOTE CHAR MVI C,CHAR # ; DEFAULT CALL CKQC ; VALIDATE STA RQUO MOV C,A ; SAVE (AND RETURN) LDA SQU8 ; 8-BIT MOV E,A ; ALSO SAVE CALL GETOP ; 8-BIT QUOTE CALL CKQ8 ; VALIDATE HIM MOV D,A ; SWAP MOV A,E MOV E,D CALL CKQ8 ; VALIDATE ME CMP E ; AGREE? JZ *+4 ; YES, OK MOV A,C ; NO, TURN OFF STA RQU8 CALL GETOP ; BLOCK CHECK CALL CKBKC ; VALIDATE IT MOV D,A LDA BKTP CMP D ; DO WE AGREE? CNZ CKBK1 ; NO, USE '1' SUI CHAR 0 ; CONVERT TO BINARY STA BCTN+1 ; AND SAVE CALL GETOP ; REPEAT PRFX CPI 41Q JC NRPT ; INVALID CPI DEL JNC NRPT ; NOPE CMP E ; DUPLICATE? JNZ *+4 ; OK NRPT MOV A,C ; TURN OFF STA RPTQ RET * * FETCH PARAMETER BYTE (OR BLANK IF NONE) GETOP MVI A,BL ; DEFAULT DCR B ; ANY MORE DATA? RM ; NO, USE DEFAULT MOV A,M ; YES, GET IT INX H RET * * VALIDATE QUOTE CHAR IN (A), DFLT=(C) CKQ8 CPI CHAR Y ; SPECIAL MEANING FOR 8-BIT JNZ CKQC MOV A,E ; USE OTHER'S CKQC CPI 41Q ; MUST BE PRINTABLE JC DFQC ; NO CPI 77Q ; NOT UPCASE RC ; OK CPI 140Q JC DFQC CPI DEL RC ; OK DFQC MOV A,C ; DEFAULT RET * * VALIDATE BLOCK-CHECK IN (A) CKBKC CPI CHAR 2 ; ONLY ALTERNATIVE TO '1' RZ ; OK CKBK1 MVI A,CHAR 1 ; DEFAULT IS 1 RET EJECT * GET CHAR FROM DATACOMM GCH PUSH B ; SAVE REGS PUSH D PUSH H RTIM EQU *+2 ; TIME OUT PERIOD LXI H,0 PUSH H ; TIMEOUT COUNTER GCHL POP H DCX H ; COUNT LOOPS MOV A,H ORA L ; RUN DOWN? TIMER1 JZ TIMEOUT ; OR 'JC' TO DISABLE PUSH H CALL CKXZ ; SEE IF INTERRUPT LXI H,GETDC PUSH H RST 2 ; GET CHAR JZ GCH9 ; GOT ONE LDA KBSTT CMA ; CHECK FOR CNTL+SHIFTS ANI 31Q ; ALL? JNZ GCHL ; NO, CHECK AGAIN CALL SCRBOT ; INTERRUPT GTKL CALL WAITU ; READ KBD ORA A ; CHECK FOR FUNCTIONS JM GTKW ; DON'T SEND THEM LXI H,XPUTDC PUSH H RST 2 ; SEND GTKW CPI CR JZ GCHL ; NOW TRY AGAIN CALL WCHAR JMP GTKL GCH9 POP H ; FLUSH COUNTER POP H POP D POP B MARK EQU *+1 CPI 1 ; SYNCH RET TIMEOUT LXI H,8 ; HOST IS STALLED DAD SP ; FLUSH SAVED STUFF SPHL MVI A,CHAR T ; INDICATE TIMEOUT ORA A ; SET 'NZ' GCHTX JMP 0-0 * * CHECK FOR INTERRUPT CKXZ LXI H,GTKEY PUSH H RST 2 RNZ ; OK, NOTHING TYPED SUI CHAR X-100Q ; CTL-X? JZ *+6 ; YES, THAT'S IT CPI CHAR Z-CHAR X ; CTL-Z? RNZ INR A STA CXZ+1 ; SAVE FLAG RET EJECT * SEND ZERO-LENGTH ACK ACK0 MVI A,CHAR Y ; ACK CALL SPACK0 ; SEND IT AND THEN ... * ADVANCE RECORD NUMBER BUMPNO LDA SSEQ SUI 37Q ANI 77Q ADI BL STA SSEQ ; UPDATE CPI BL+10 JNZ *+8 MVI A,BEL ; SET TO BEEP AFTER TRANSFER STA XFLEN LXI D,RCNOLN:TABCOL RECCT LXI H,0 ; COUNTER INX H SHLD RECCT+1 * PRINT (HL) AT (D/E) ON SCREEN SCRNO PUSH H ; SAVE NUM LHLD CRSPOS ; SAVE POSITION XCHG CALL CLRLH POP H CALL PNUM XCHG JMP SETCRS ; RESTORE POSITION * * READ DECIMAL NUMBER FROM KEYBOARD INTO (HL), BREAK IN (A) GETNUM LXI H,0 ; INIT GETNL CALL WAITU CPI CHAR 0 ; VALID DIGIT? RC ; NO, THAT'S IT CPI CHAR 9+1 RNC SUI CHAR 0 ; CONVERT TO BINARY PUSH D ; SAVE REGS MOV D,H MOV E,L ; COPY LAST VALUE DAD H DAD H DAD D ; x 5 DAD H ; x 10 MOV E,A ; NEW DIGIT MVI D,0 DAD D POP D JMP GETNL ; KEEP READING EJECT * ESTABLISH NEW STATE, THEN WAIT FOR GOOD PACKET VERIFYP SHLD VERPTR+1 VERIFY POP H SHLD VERRET+1 ; SET RETURN ADR RETRY EQU *+1 MVI A,10 ; MAX TRIES STA TRIES VER1 CALL RPACK MOV A,M ; GET TYPE CPI CHAR N ; MAYBE NAK JZ AGAIN CPI CHAR T ; MAYBE TIMEOUT JZ AGAIN CPI CHAR E ; MAYBE ERROR CZ OOPSE DCX H ; PTR TO REC NO LDA SSEQ ; LAST SENT CMP M ; MATCH? JNZ VERBAD ; NO, TRY AGAIN INX H ; OK MOV A,M ; RETRIEVE TYPE VERPTR LXI H,*-* MOV E,M ; GET PTR TO END OF LIST INX H MOV D,M INX H STAX D ; INSERT GUARD JMP CMDSP * VERBAD MVI A,CHAR K ; BAD REC NO AGAIN CALL BUMPT LXI H,VER1 PUSH H ; SET 'RETURN' ADR SNDFL MVI A,CHAR N CPI CHAR N ; ANYTHING SENT YET JZ SPACK0 ; NO, SEND NAK JMP SPSND ; RESEND * VERACK LDA RLEN ; GOT ACK DCR A ; ANY DATA? JNZ VERRET LDA RDAT ; GET ONE-AND-ONLY SUI CHAR X-1 ; X OR Z? JC VERRET STA CXZ+1 ; YES, THAT'S IT FOLKS VERRET JMP *-* * * COUNT RETRIES BUMPT STA ECODEB ; TYPE OF ERROR LXI H,TRIES DCR M CZ ERTR ; RAN OUT RTRCT LXI H,0 INX H PRTRY SHLD RTRCT+1 ; ENTER HERE WITH NEW RETRY TOTAL LXI D,RTRYLN:TABCOL JMP SCRNO EJECT * INITIAL STATE FOR RECEIVE RCVSTI DW RCVSTIZ ; END OF LIST DB CHAR S ; SEND-INIT DW VERRET RCVSTIZ DS 1 DW ERTP * RECEIVE WAITING FOR FILE HEADER RCVSTH DW RCVSTHZ ; END OF LIST DB CHAR F ; DISK FILE DW VERRET DB CHAR X ; DISPLAY FILE DW VERRET DB CHAR B ; BREAK CONNECTION DW RCVBRK RCVSTHZ DS 1 * RECEIVE WAITING FOR DATA RCVSTD DW RCVSTDZ ; END OF LIST DB CHAR D ; DATA PACKET DW VERRET DB CHAR Z ; END OF FILE DW RCVEOF RCVSTDZ DS 1 DW ERTP * SENDING FILE SNDST DW SNDSTZ ; END OF LIST DB CHAR Y ; ACK IS ONLY ALLOWED DW VERACK SNDSTZ DS 1 DW ERTP * SENDING SERVER COMMAND CMDST DW CMDSTZ ; END OF LIST DB CHAR Y ; ACK DW VERACK DB CHAR S ; LONG REPLY (IF ALLOWED) DW RCV2 CMDSTZ DS 1 DW ERTP EJECT * ERROR HANDLER OOPSE LXI H,EMSGLN:TABCOL-7 CALL PCRS ASCC 'Error: ' LXI H,RDAT CALL PSTR ; DISPLAY MESSAGE CALL PEMSG ASCC 'Remote host aborted' * OOPS POP D ; MSG PTR POP H ; ERROR ADR SHLD ERADR XCHG MOV C,M ; GET LENGTH INX H PUSH H MVI A,CHAR E ; ERROR PACKET CALL SPACK PEMSG CALL BEEPM ; MESSAGE SET UP POP H CALL PSTR ; DISPLAY RSTSP LXI SP,0-0 ; ABORT JMP WAITING * * INDIVIDUAL ERRORS ERAK CALL OOPS DB ERAKL ASCC 'Bad INIT data' ERAKL EQU *-ERAK-5 ERIO CALL OOPS DB ERIOL ASCC 'I/O error' ERIOL EQU *-ERIO-5 EROTH CALL OOPS DB EROTHL ASCC 'Unknown error' EROTHL EQU *-EROTH-5 ERQU CALL OOPS DB ERQUL ASCC 'Split prefix' ERQUL EQU *-ERQU-5 ERRP CALL OOPS DB ERRPL ASCC 'Bad repeat count' ERRPL EQU *-ERRP-5 ERTP CALL OOPS DB ERTPL ASCC 'Bad packet type' ERTPL EQU *-ERTP-5 ERTR CALL OOPS DB ERTRL ASCC 'Retry limit - ',- ; N=> NAK OR BAD PACKET, T=> TIMEOUT ECODEB DB 0,0 ; K=> BAD PACKET NUMBER ERTRL EQU *-ERTR-5 ; OTHER=> BAD PACKET TYPE ERWR CALL OOPS DB ERWRL ASCC 'No local storage' ERWRL EQU *-ERWR-5 EJECT * EXIT TO TERMINAL MONITOR EXIT MVI B,1 CALL SWNDW CALL SCRBOT CALL PSTRLOC ASCC 'TERMINAL READY'013010'' RETAD JMP 0-0 * * OPEN A FILE FOR OUTPUT FBSET LXI H,OUTFB+3 ; PTR TO FILE BLOCK MVI M,3 LXI H,$OUTOPN FSYSO LXI D,OUTFB ; FB PTR JMP FSYS * CLOSE A FILE FBRLSE LXI H,$CLOSE ; SYS CLOSE LDAX D ; CHECK CODE ORA A RZ ; NOT ASSIGNED, SKIP IT * DO IT FSYS PUSH H XCHG ; GET REQUESTED FB SHLD FBPTR ; SET UP FB MVI A,2 CALL CALROM LHLD FBPTR INX H MOV A,M ; GET RET CODE ORA A RET * * SOUND BELL, THEN POSITION CURSOR TO MESSAGE FIELD BEEPM LXI H,BELL PUSH H RST 2 MSGS LXI H,MSGLN:0 CLRLH CALL SETCRS ; POSITION TO (HL) PUSH H LXI H,CLEARL ; CLEAR LINE JMP EXRST2 * * HOME CURSOR CRS00 LXI H,0 * MOVE CURSOR TO HL=ROW:COL SETCRS SHLD CRSPOS ; SET POS'N PUSH H LXI H,$CURPLC EXRST2 PUSH D PUSH B MOV C,A PUSH H RST 2 POP B POP D POP H RET EJECT * * DISPLAY WINDOW IN (B) SWNDW MVI A,1 LXI H,$WINDW PUSH H RST 2 RET * * READ, UPCASE A CHARACTER WAITU CALL WAIT1 JNZ WAITU CPI KRET ; RETURN KEY JNZ *+5 MVI A,CR UPPER CPI 96+27 RNC CPI 96+1 RC SUI 32 RET * GET CHAR, IF ANY WAIT1 PUSH H LXI H,GTKEY JMP EXRST2 EJECT * CONTROL BLOCKS, POINTERS * INDIC LXI H,1:TABCOL CALL PCRS ASCC 'Btpp."8BR' LDA LNAME STA LNMS LDA RNAME STA RNMS QUOTE EQU *+1 MVI A,CHAR # STA SQUO ; DEFAULT OPTION DPTQ EQU *+1 MVI A,CHAR ~ STA SPTQ BUFSZ EQU *+1 MVI A,94 ADI BL STA SNITP TIME EQU *+1 MVI A,3 ADI BL STA STIM LXI H,2:TABCOL-7 CALL PCRS ; DISPLAY SET PARMS ASCC 'Parms: ',- * SEND INIT DATA SNITP DB 94+BL ; BUFSIZ STIM DB 3+BL ; TIMEOUT DB 0+BL ; NPAD DB 100Q ; PAD DB CR+BL ; EOL SQUO DB CHAR # ; QUOTE SQU8 DB CHAR Y ; 8-BIT QUOTE BKTP DB CHAR 1 ; CHECK TYPE SPTQ DB CHAR ~ ; REPEAT PRFX SNITL EQU *-SNITP ASCC ' Src: ',- LNMS ASCC '* Dst: ',- RNMS DB CHAR * DB 0 ; MARKS END OF STRING CALL MSGS ; SET UP MESSAGE FOR VALUES XRA A STA SNTBLZ ; MARK END OF TABLE LXI H,SNTBL INDLP MOV A,M ORA A ; REACHED END? RZ ; YES CALL WCHAR ; NO, PRINT NEXT OPTION INX H MOV E,M ; FETCH LOCATION INX H MOV D,M INX H XCHG MOV L,M ; FETCH VALUE CALL PNUM1 MVI A,BL CALL WCHAR XCHG INX H ; SKIP OVER LIMITS INX H ; SKIP OVER LIMITS JMP INDLP * * DUMMY FILE NAME SFN ASCC 'A.B' SFNL EQU *-SFN-1 FILMSG ASCC 'File: ',- FILMS2 DS 20 LFILM2 EQU *-FILMS2-1 FNM ASCC 'NULL.FILE' ; INITIAL RAM NAME DS 15 FNML EQU *-FNM FNMLEN DB 9 * RAMD0 DW RAMDSK ; START OF BUFFER TRIES DS 1 ; RETRY COUNTER ERADR DS 2 ; ERROR DETECTION ADR * * SEND PACKET SPAKT DS 2 ; MARK, LENGTH SSEQ DS 1 ; PACKET NUMBER STYPE DS 1 ; RECORD TYPE SDAT DS 96 * RECEIVE INFO RLEN DS 1 ; COUNT BUF DS 128 RTYPE EQU BUF+1 RDAT EQU BUF+2 * * OUTPUT FILE BLOCK OUTFB DB 0,0,0,3 DW RNAME OUTFBB DW 0 OUTFBC DB 0,0 OUTFBA DW OUTARG DS 6 OUTARG DS 3 RNAME ASCC 'R'13'' DS 6 * INPUT FILE BLOCK TMPFB DB 0,0,0,3 DW LNAME TMPFBB DW 0 TMPFBC DB 0,0 DW OUTARG DS 6 LNAME ASCC 'L'13'' DS 6 EJECT * DISPLAY MESSAGE FROM IN-LINE PMSG CALL MSGS JMP PSTRLOC PCRS CALL SETCRS ; MOVE TO (HL) PSTRLOC XTHL ; GET PTR CALL PSTR XTHL RET * DISPLAY MESSAGE AT (HL) PSTR MOV A,M INX H ORA A RZ ; STOP AT NULL CALL WCHAR JMP PSTR * * WRITE CHARACTER FROM (A) WCHAR PUSH H LXI H,CHINT0 JMP EXRST2 * * DISPATCH FROM COMMAND LIST CMDSP CMP M ; COMPARE AGAINST TABLE INX H MOV E,M ; FETCH COMMAND ADR INX H MOV D,M INX H JNZ CMDSP ; KEEP LOOKING XCHG PCHL ; GO DO IT * * DISPLAY FROM (L) PNUM1 MVI H,0 * DISPLAY DECIMAL NUMBER FROM (HL) PNUM PUSH B ; SAVE REGS. PUSH D XCHG LXI H,DECBUF PUSH H LXI H,BN2DEC XTHL RST 2 ; CONVERT TO STRING LXI H,DECBUF CALL PSTR POP D POP B RET END