home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
hp2647.tar.gz
/
hp2647.tar
/
hp264x.asm
< prev
next >
Wrap
Assembly Source File
|
1988-08-16
|
54KB
|
1,754 lines
* 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