home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / hp2647 / hp264x.asm < prev    next >
Assembly Source File  |  2020-01-01  |  54KB  |  1,754 lines

  1. * Date: 1987 Sep 28   22:51 EDT
  2. * From: (John F. Chandler)   PEPMNT@CFAAMP.BITNET
  3. *
  4. * ROVKERM v. 1.2 - KERMIT for the HP2647A terminal
  5. *
  6. @@1      EQU   TIMER         ; On/off switch for timer.
  7. @@2      EQU   IBM           ; On/off switch for IBM wait.
  8. *
  9.          ORG   400Q
  10. RAMDSK   EQU   *             ; START OF 32K 'RAM DISK'
  11.          ORG   100400Q       ; 256 EXTRA OVERLAP
  12.          ASCC  'UKERMIT  '255255'',-
  13.          JMP   IN            ; ENTRY VECTOR ...
  14.          JMP   RTRN
  15.          JMP   IN
  16.          XRA   A
  17.          RET
  18.          NOP
  19.          JMP   RTRN
  20.          JMP   RTRN
  21.          JMP   RTRN
  22.          EJECT
  23. *          A FEW ASCII CHARS
  24. BEL      EQU   7
  25. BL       EQU   32
  26. BS       EQU   8
  27. CR       EQU   13
  28. DEL      EQU   127
  29. ESC      EQU   27
  30. LF       EQU   10
  31. XON      EQU   17
  32. KRET     EQU   357Q          ; KEYBOARD CODE FOR RETURN
  33. *
  34. EMSGLN   EQU   3             ; SCREEN LINE FOR HOST ERROR
  35. FIDLN    EQU   4             ; FILE NAME
  36. RCNOLN   EQU   5             ; RECORD COUNT
  37. RTRYLN   EQU   6             ; RETRY COUNT
  38. MSGLN    EQU   7             ; VARIOUS MESSAGES
  39. TABCOL   EQU   12            ; COMMON TAB COLUMN
  40. *
  41. *          SYSTEM ENTRY POINTS
  42. SYSCPY   EQU   100Q          ; COPY (C) FROM (HL) TO (DE)
  43. CALROM   EQU   106Q          ; CALL ROM CODE AT (STACK)
  44. *
  45. CURPHD   EQU   144Q          ; HOME DOWN CURSOR
  46. CLEARL   EQU   155Q          ; CLEAR LINE FROM CURSOR
  47. CLEARS   EQU   160Q          ; CLEAR DISPLAY FROM CURSOR
  48. XPUTDC   EQU   174Q          ; XMIT CHAR TO DCM FROM (A)
  49. CHINT0   EQU   202Q          ; DISPLAY CHARACTER FROM (C)
  50. MLKOF0   EQU   232Q          ; TURN ON MEM LOCK AT (177553)
  51. BN2DEC   EQU   250Q          ; CONVERT TO DECIMAL
  52. $WINDW   EQU   352Q          ; DISPLAY WINDOW IN (B)
  53. $KBFNC   EQU   402Q          ; DISPLAY CHAR OR FUNCTION IN (C)
  54. $KBPRC   EQU   410Q          ; UPDATE KEYBOARD STATE
  55. $CURPLC  EQU   413Q          ; CLEAN UP DISPLAY/CURSOR
  56. GTKEY    EQU   64005Q        ; GET KEY CODE, IF ANY
  57. BELL     EQU   64024Q        ; RING BELL
  58. GETDC    EQU   70030Q        ; GET CHAR FROM DCM, IF ANY
  59. *          FILE SYSTEM
  60. $INOPN   EQU   422Q          ; OPEN FILE FOR INPUT
  61. $CLOSE   EQU   425Q          ; CLOSE FILE
  62. $OUTOPN  EQU   430Q          ; OPEN FOR OUTPUT
  63. $READ    EQU   433Q          ; GET RECORD
  64. $WRITE   EQU   436Q          ; PUT RECORD
  65. $CNTRL   EQU   441Q          ; PERFORM CONTROL OPERATION
  66. *          SYSTEM VARIABLES
  67. DCMIP    EQU   175673Q       ; DCM RING BUFFER INPUT POINTER
  68. DCMOP    EQU   175675Q       ; DCM RING BUFFER OUTPUT POINTER
  69. KBSTT    EQU   175762Q       ; KEYBOARD STATE
  70. FBPTR    EQU   176136Q       ; SYSTEM PTR TO CURRENT FB
  71. DECBUF   EQU   177011Q       ; TEMP BUFFER
  72. LOKROW   EQU   177553Q       ; SCREEN ROW TO LOCK
  73. FREPTR   EQU   177613Q       ; PTR TO FREE MEMORY
  74. CRSPOS   EQU   177700Q       ; CURSOR POSITION
  75.          EJECT
  76. *          INITIALIZE PROGRAM
  77. IN       POP   H             ; SAVE RETURN ADDRESS
  78.          SHLD  RETAD+1
  79.          LHLD  FREPTR        ; STACK AREA
  80.          LXI   D,-257
  81.          DAD   D
  82.          SHLD  OUTFBB        ; GET BUFFER
  83.          SHLD  TMPFBB
  84.          SHLD  RSTSP+1       ; FOR QUITTING
  85.          SPHL
  86.          MVI   B,4           ; DSPLY IN WINDOW 4
  87.          CALL  SWNDW
  88.          XRA   A
  89.          STA   STYPE
  90.          MVI   A,MSGLN+1
  91.          STA   LOKROW
  92.          LXI   H,MLKOF0      ; LOCK SCREEN
  93.          PUSH  H
  94.          RST   2
  95.          CALL  CRS00         ; SCREEN HOME
  96.          LXI   H,CLEARS      ; CLEAR ALL
  97.          PUSH  H
  98.          RST   2
  99.          CALL  PSTRLOC
  100.          ASCC  'Rover Kermit 1.2'   ; UPDATE AS VERSION CHANGES
  101.          LXI   H,0:40
  102.          CALL  PCRS
  103.          ASCC  'Send, Receive, Get, Quit, Finish, Logout'
  104.          LXI   H,1:40
  105.          CALL  PCRS
  106.          ASCC  'Core, Tape, Kermit, Parm'
  107.          CALL  DEVFLG
  108.          CALL  INDIC         ; DISPLAY FLAGS
  109.          LXI   H,RCNOLN:TABCOL-8
  110.          CALL  PCRS
  111.          ASCC  'Record:'
  112.          LXI   H,RTRYLN:TABCOL-9
  113.          CALL  PCRS
  114.          ASCC  'Retries:'
  115.          EJECT
  116. *          COMAND LOOP
  117. WAITING  MVI   A,1
  118.          STA   BLOCK         ; RESTORE USUAL BLOCK CHECK
  119.          CALL  WAITU         ; GET CHAR
  120.          STA   CMTBZ
  121.          LXI   H,CMTBL
  122.          CALL  CMDSP         ; FIND AND CALL COMMAND ROUTINE
  123.          JMP   WAITING       ; RESUME
  124. *
  125. *          COMMAND TABLE
  126. CMTBL    DB    CHAR C
  127.            DW  CORE          ; TO/FROM MEMORY
  128.          DB    CHAR E
  129.            DW  EXIT
  130.          DB    CHAR F
  131.            DW  UNSRV         ; FINISH
  132.          DB    CHAR G
  133.            DW  GET
  134.          DB    CHAR K
  135.            DW  KERMCMD
  136.          DB    CHAR L
  137.            DW  UNSRV         ; LOGOUT
  138.          DB    CHAR P
  139.            DW  SET           ; PARM
  140.          DB    CHAR Q
  141.            DW  EXIT
  142.          DB    CHAR R
  143.            DW  RECEIVE
  144.          DB    CHAR S
  145.            DW  SEND
  146.          DB    CHAR T
  147.            DW  TAPE          ; TO/FROM TAPE
  148.          DB    128+CHAR h
  149.            DW  FUNC          ; HOME
  150.          DB    128+CHAR F
  151.            DW  FUNC          ; HOME DOWN
  152.          DB    128+CHAR S
  153.            DW  FUNC          ; ROLL UP
  154.          DB    128+CHAR T
  155.            DW  FUNC          ; ROLL DOWN
  156.          DB    128+33Q
  157.            DW  FUNC          ; COMMAND MODE
  158. CMTBZ    DB    0
  159.            DW  ERR1          ; NONE OF THE ABOVE
  160. *
  161. ERR1     CALL  MSGBP
  162.          ASCC  'Bad command'
  163. MSGBP    CALL  BEEPM
  164. MSGNO    POP   H             ; PTR TO MESSAGE
  165.          JMP   PSTR
  166. *
  167. *          PERFORM SCREEN FUNCTION
  168. FUNC     MOV   C,A
  169.          LXI   H,$KBFNC
  170.          PUSH  H
  171.          RST   2
  172.          JMP   WAITING
  173.          EJECT
  174. *          PERFORM SET FUNCTION
  175. SET      CALL  SCRSET
  176.          ASCC  'Prm: oN, oFf, Chr, Val'
  177.          CALL  WAITU         ; GET COMMAND
  178.          LXI   H,EMSGLN:5
  179.          CPI   CHAR C        ; CHAR?
  180.          JZ    SETCHR
  181.          CPI   CHAR V        ; VALUE?
  182.          JZ    SETVAL
  183.          MVI   B,160Q        ; MOV M,B
  184.          CPI   CHAR F        ; OFF?
  185.          JZ    SETFLG
  186.          INR   B             ; MOV M,C
  187.          CPI   CHAR N        ; ON?
  188.          JNZ   ERR1          ; NONE OF THE ABOVE
  189. SETFLG   MOV   A,B
  190.          STA   STFL          ; SET ON OR OFF
  191.          CALL  PCRS          ; PROMPT FOR OPTION
  192.          ASCC  'IBM, Timer, 8-bit'
  193.          CALL  WAITU
  194.          LXI   D,STBLZ
  195.          LXI   H,STBL
  196.          CALL  FLLK          ; LOOK UP OPTION
  197.          XCHG
  198. STFL     MOV   M,C           ; OR MOV M,B
  199.          JMP   INDIC         ; DISPLAY LATEST SETTINGS
  200. *
  201. SETVAL   CALL  PCRS          ; PROMPT FOR OPTION
  202.          ASCC  'Bufsz, Hndshk, Mark, Retry, Time'
  203.          CALL  GETNUM
  204.          PUSH  H
  205.          LXI   D,SNTBLZ
  206.          LXI   H,SNTBL
  207.          CALL  FLLK          ; LOOK UP OPTION
  208.          POP   H             ; RETRIEVE VALUE
  209.          MOV   A,L
  210.          CMP   C
  211.          JC    ERR1          ; TOO SMALL
  212.          CMP   B
  213.          JNC   ERR1          ; TOO BIG
  214.          STAX  D             ; SET NEW VALUE
  215.          JMP   INDIC         ; DISPLAY LATEST SETTINGS
  216. *
  217. SETCHR   CALL  PCRS          ; PROMPT FOR OPTION
  218.          ASCC  'Src, Dest, Quote, Rept, 8-bit, Blk-chk'
  219.          CALL  WAITU
  220.          LXI   D,SCTBLZ
  221.          LXI   H,SCTBL
  222.          CALL  FLLK          ; LOOK UP OPTION
  223.          PUSH  B
  224.          CALL  WAITU
  225.          POP   H
  226.          MOV   C,M           ; USE OLD VALUE AS 'DEFAULT'
  227.          XCHG
  228.          RST   1             ; CALL CHECKER
  229.          STAX  D             ; STORE NEW VALUE
  230.          JMP   INDIC         ; DISPLAY LATEST SETTINGS
  231.          EJECT
  232. *          OPTION LOOK-UP
  233. FLLK     PUSH  D             ; SAVE END OF TABLE
  234.          STAX  D             ; MARK LAST ITEM
  235. FLLP     CMP   M             ; FOUND?
  236.          INX   H
  237.          MOV   E,M           ; GET ADR
  238.          INX   H
  239.          MOV   D,M
  240.          INX   H
  241.          MOV   C,M           ; GET DATA
  242.          INX   H
  243.          MOV   B,M
  244.          INX   H
  245.          JNZ   FLLP          ; NOT FOUND YET
  246.          MOV   A,L           ; SAVE ITEM PTR
  247.          POP   H             ; RETRIEVE PTR TO END OF LIST
  248.          SUB   L
  249.          POP   H             ; GRAB RETURN ADR
  250.          DCR   A
  251.          JP    ERR1          ; RAN OFF END
  252.          PCHL                ; OK
  253. *
  254. *          TABLE OF ON/OFF SWITCHES
  255. STBL     DB    CHAR I        ; IBM
  256.            DW  IBM,INSTR CALL:INSTR LXI
  257.          DB    CHAR T        ; TIMER
  258.            DW  TIMER,INSTR JZ:INSTR JC
  259.          DB    CHAR 8        ; 8-BIT
  260.            DW  SQU8,CHAR Y:CHAR N
  261. STBLZ    DB    0
  262. *          TABLE OF CHARACTER OPTIONS: CHECK ROUTINE, LOCATION
  263. SCTBL    DB    CHAR S        ; SOURCE
  264.            DW  UPPER,LNAME
  265.          DB    CHAR D        ; DESTINATION
  266.            DW  UPPER,RNAME
  267.          DB    CHAR Q        ; QUOTE
  268.            DW  CKQC,QUOTE
  269.          DB    CHAR R        ; REPEAT
  270.            DW  CKQC,DPTQ
  271.          DB    CHAR 8        ; 8-BIT
  272.            DW  CKQC,SQU8
  273.          DB    CHAR B        ; BLOCK-CHECK
  274.            DW  CKBKC,BKTP
  275. SCTBLZ   DB    0
  276. *          TABLE OF VALUE OPTIONS: LOCATION, MIN:MAX+1
  277. SNTBL    DB    CHAR B        ; BUFFER SIZE
  278.            DW  BUFSZ,20:95
  279.          DB    CHAR H        ; HANDSHAKE CODE
  280.            DW  HNDSHK,0:BL
  281.          DB    CHAR M        ; MARK
  282.            DW  MARK,0:BL
  283.          DB    CHAR R        ; RETRY
  284.            DW  RETRY,1:200
  285.          DB    CHAR T        ; TIME-OUT
  286.            DW  TIME,1:95
  287. SNTBLZ   DB    0
  288.          EJECT
  289. *          RESET DIALOG
  290. SCRSET   LXI   H,$KBPRC
  291.          PUSH  H
  292.          RST   2             ; UPDATE STATE
  293.          LXI   H,0
  294.          SHLD  RECCT+1
  295.          CALL  PRTRY
  296.          XRA   A
  297.          STA   CXZ+1         ; CLEAR INTERRUPT FLAG
  298.          MVI   A,XON
  299.          STA   XFLEN         ; ASSUME QUICK TRANSFER
  300.          LDA   STYPE
  301.          ORA   A
  302.          CNZ   DCMFLH        ; FLUSH BUFFER
  303.          MVI   A,BL          ; PACKET NUMBER
  304.          STA   SSEQ
  305.          MVI   A,CHAR N
  306.          STA   SNDFL+1       ; NOTHING SENT YET
  307.          MVI   A,INSTR LXI
  308.          STA   SPSND         ; DISABLE
  309.          LXI   H,EMSGLN:0
  310.          CALL  CLRLH
  311.          POP   H
  312.          CALL  PSTR          ; SHOW CMD NAME
  313.          PUSH  H
  314. SCRBOT   LXI   H,CURPHD      ; HOME DOWN
  315.          PUSH  H
  316.          RST   2
  317.          RET
  318. *          FLUSH DCM BUFFER
  319. DCMFLH   LDA   IBM
  320.          CPI   INSTR CALL
  321.          RZ                  ; IBM'S DON'T TYPE AHEAD
  322.          DI
  323.          LHLD  DCMIP
  324.          SHLD  DCMOP         ; RESET BUFFER PTRS
  325.          EI
  326.          RET
  327. *
  328. *          STORAGE IN MEMORY
  329. CORE     LXI   H,RAMOUT
  330.          LXI   D,RAMIN
  331.          LXI   B,STAR+6
  332. SETDEV   SHLD  RCVSET+1
  333.          XCHG
  334.          SHLD  SNDSET+1
  335.          MOV   H,B           ; COPY PTR TO MARKER STRING
  336.          MOV   L,C
  337.          SHLD  DEVFM+1
  338. DEVFLG   CALL  CRS00         ; MOVE CURSOR AWAY ...
  339.          LXI   H,2:40
  340.          CALL  SETCRS        ; AND BACK
  341. DEVFM    LXI   H,STAR
  342.          JMP   PSTR          ; MARK CURRENT SOURCE
  343. *          STORAGE ON TAPE
  344. TAPE     LXI   H,TAPOUT
  345.          LXI   D,TAPIN
  346.          LXI   B,STAR
  347.          JMP   SETDEV
  348. STAR     ASCC  '      *      '
  349.          EJECT
  350. *          RECEIVE A FILE
  351. RECEIVE  CALL  SCRSET        ; CLEAR RETRY COUNT, ETC
  352.          ASCC  'Rcv'
  353. RCV1     LXI   H,RCVSTI      ; SET UP INITIAL WAIT STATE
  354.          CALL  VERIFYP       ; GET GOOD PACKET
  355. RCV2     CALL  GETPRM        ; VALIDATE PARMS
  356.          CMP   C             ; REPEAT PRFX = QUOTE?
  357.          JNZ   *+5           ; NO, THEN USE IT
  358.          MVI   A,BL          ; FORBID
  359.          STA   SPTQ          ; FOR ACK
  360.          MOV   A,C
  361.          STA   SQUO
  362.          LXI   H,SNITP       ; ACK DATA
  363.          MVI   C,SNITL       ; LENGTH
  364.          MVI   A,CHAR Y
  365.          CALL  SPACK         ; DO IT
  366.          CALL  BUMPNO
  367.          LDA   BCTN+1        ; NEGOTIATED BLOCK CHECK
  368.          STA   BLOCK         ; NOW USE IT
  369. RHEDR    LXI   H,RCVSTH      ; EXPECT FILE HEADER
  370.          CALL  VERIFYP       ; GET GOOD PACKET
  371.          LXI   H,BUFOUT
  372.          LXI   D,FILMS2
  373.          MVI   A,LFILM2
  374.          CALL  SETDCD
  375.          CALL  DECODE
  376.          MVI   M,0           ; MARK END
  377.          MOV   A,L
  378.          SUI   FILMS2>400Q   ; GET LENGTH OF NAME
  379.          STA   FNMLT+1
  380.          LXI   H,FIDLN:TABCOL-6
  381.          CALL  CLRLH
  382.          LXI   H,FILMSG      ; File: ...
  383.          CALL  PSTR
  384.          CALL  SCRBOT
  385. RCVSET   LXI   H,TAPOUT
  386.          LDA   RTYPE
  387.          CPI   CHAR X
  388.          JNZ   *+6
  389.          LXI   H,SCRNOUT     ; TEXT HEADER: DISPLAY
  390.          CALL  SETDCDX
  391.          LXI   H,RCVSTD      ; NOW EXPECT DATA PACKETS
  392.          SHLD  VERPTR+1
  393. RDATA    CALL  ACK0          ; SEND ACK
  394.          CALL  VERIFY        ; WAIT FOR NEXT
  395.          CALL  DECODE        ; DECODE FROM PACKET
  396.          JMP   RDATA         ; ACK AND WAIT
  397. RCVEOF   STC
  398.          CALL  DCDOPR        ; HANDLE END
  399.          CALL  ACK0
  400.          JMP   RHEDR         ; WAIT FOR ANOTHER FILE
  401. RCVBRK   CALL  ACK0          ; DONE RECEIVING
  402. RCVOK    LDA   CXZ+1         ; HALT?
  403.          DCR   A
  404.          JP    RCVDIE        ; YES
  405.          CALL  MSGNO
  406. XFLEN    ASCC  ' Transfer done'   ; START WITH BEEP OR XON
  407. RCVDIE   CALL  MSGBP
  408.          ASCC  'Transfer halted'
  409.          EJECT
  410. *          SEND ARBITRARY COMMAND
  411. KERMCMD  CALL  SCRSET
  412.          ASCC  'Cmd'
  413.          CALL  PMSG
  414.          ASCC  'Enter command'
  415.          CALL  WAITU         ; GET TYPE
  416.          CALL  RDST          ; GET STRING
  417.          RZ
  418.          CALL  ENCSTR        ; ENCODE AND SEND IT
  419.          LXI   H,CMDST       ; EXPECT ACK OR LONG REPLY
  420.          CALL  VERIFYP
  421.          DCX   H
  422.          MOV   A,M           ; SEE IF 'SHORT REPLY'
  423.          ORA   A
  424.          RZ
  425.          CALL  SCRBOT
  426.          LXI   H,RDAT
  427.          JMP   PSTR          ; JUST DISPLAY IT
  428. *
  429. *          GET A FILE FROM KERMIT SERVER
  430. GET      CALL  SCRSET
  431.          ASCC  'Get'
  432.          MVI   A,CHAR R      ; RECEIVE INIT
  433.          CALL  RDFNT
  434.          JZ    *-5           ; INSIST
  435.          CALL  ENCSTR        ; ENCODE AND SEND NAME
  436.          JMP   RCV1          ; NOW RECEIVE IT
  437. *
  438. *          ISSUE SERVER COMMAND
  439. UNSRV    CPI   CHAR L        ; LOGOUT?
  440.          JNZ   UNSRV2        ; NO, JUST DO IT
  441.          CALL  BEEPM         ; YES, GET CONFIRMATION
  442.          CALL  PSTRLOC
  443.          ASCC  'Logout? (Y|N) '
  444.          CALL  WAITU
  445.          CPI   CHAR Y
  446.          JNZ   ERR1          ; NOT CONFIRMED: GOOF
  447. UNSRV2   CALL  SCRSET
  448.          ASCC  'Cmd'
  449.          LXI   H,STYPE
  450.          MVI   M,CHAR G      ; 'GENERIC'
  451.          INX   H
  452.          LDA   CMTBZ         ; TYPED COMMAND
  453.          MOV   M,A
  454.          MVI   B,1           ; 1 BYTE OF DATA
  455.          CALL  SPACKC        ; SEND IT
  456.          JMP   EXIT
  457.          EJECT
  458. *          GET FILE NAME AND SEND
  459. RDFNT    PUSH  PSW           ; PACKET TYPE
  460.          CALL  PMSG
  461.          ASCC  'Enter file name'
  462.          POP   PSW
  463. RDST     STA   STYPE         ; SAVE PACKET TYPE
  464.          LXI   H,BUF         ; PUT STRING HERE
  465.          MOV   E,L           ; SAVE START OF DATA
  466.          MVI   A,CHAR :
  467. RDVLP    CALL  WCHAR
  468. RDVL2    PUSH  H
  469.          CALL  WAITU         ; GET CHAR
  470.          POP   H
  471.          CPI   CR            ; RET?
  472.          JZ    RDVZ          ; DONE
  473.          CPI   DEL
  474.          JZ    RDVBS         ; TREAT DEL AS BS
  475.          JNC   RDVL2         ; FUNCTION KEY
  476.          CPI   BS
  477.          JNZ   RDVX          ; ORD. CHAR
  478. RDVBS    MOV   A,L           ; MUST BACK UP
  479.          CMP   E             ; EMPTY?
  480.          JZ    RDVL2         ; YES, READ MORE
  481.          DCX   H
  482.          MVI   A,BS          ; AND BACK UP CURSOR
  483.          JMP   RDVLP
  484. RDVX     CPI   BL            ; CTL?
  485.          JC    RDVL2         ; IGNORE
  486.          MOV   M,A           ; ADD TO BUFFER
  487.          INX   H
  488.          JMP   RDVLP
  489. RDVZ     MOV   A,L
  490.          SUB   E             ; GET LENGTH
  491.          RZ
  492.          MVI   M,0           ; MARK END OF STRING
  493.          PUSH  PSW           ; SAVE LENGTH
  494.          CALL  SCRBOT
  495.          LXI   H,BUF         ; STRING STARTS HERE
  496.          POP   PSW
  497.          ORA   A             ; RETURN 'NZ'
  498. RTRN     RET
  499.          EJECT
  500. *          SEND A FILE FROM CURRENT POSITION ON TAPE
  501. SEND     CALL  SCRSET
  502.          ASCC  'Snd'
  503.          MVI   A,INSTR LXI+20Q
  504.          STA   EOFFL
  505.          MVI   A,CHAR S
  506.          LXI   H,SNITP       ; INIT PACKET
  507.          MVI   C,SNITL
  508.          CALL  SPACK         ; SEND IT
  509.          LXI   H,SNDST       ; EXPECT ACK'S
  510.          CALL  VERIFYP
  511.          CALL  GETPRM        ; ANALYZE RESPONSE
  512.          LXI   H,SPTQ        ; MY SUGGESTION
  513.          CMP   M             ; AGREES?
  514.          JZ    *+7           ; YES, USE IT
  515.          MOV   A,C           ; NO, SUPPRESS REPEATS
  516.          STA   RPTQ
  517.          LDA   SQUO
  518.          CMP   C             ; MUST MATCH
  519.          CNZ   ERAK          ; BAD ACKNOWLEDGE
  520.          CALL  BUMPNO        ; COUNT PACKETS
  521. BCTN     MVI   A,1           ; USUAL BLOCK CHECK
  522.          STA   BLOCK
  523.          MVI   A,CHAR F
  524.          CALL  RDFNT         ; GET FILE NAME, IF ANY
  525.          JNZ   SNDNM         ; GOT NAME PTRS
  526.          LDA   SNDSET+1
  527.          CPI   RAMIN>400Q    ; FROM RAM?
  528.          LDA   FNMLEN
  529.          LXI   H,FNM
  530.          JZ    SNDNM         ; YES, THEN ALREADY GOT NAME
  531.          LXI   H,SFN         ; NO, USE DUMMY
  532.          MVI   A,SFNL
  533. SNDNM    CALL  ENCSTR        ; ENCODE AND SEND NAME
  534.          LXI   H,FIDLN:TABCOL
  535.          CALL  SETCRS        ; SET CURSOR
  536.          LHLD  SVBFP+1
  537.          CALL  PSTR          ; DISPLAY FILE NAME
  538.          CALL  SCRBOT
  539.          CALL  VERIFY
  540.          MVI   A,CHAR D      ; NOW SEND DATA
  541.          STA   STYPE
  542. SNDSET   LXI   H,TAPIN
  543.          CALL  SETDCD
  544.          XRA   A
  545.          STA   SVBFL+1       ; NO SAVED DATA
  546.          CALL  BUMPNO
  547. *          MAIN SEND LOOP
  548. SLOOP    CALL  MAKPAK        ; SEND A PACKET FROM INPUT
  549.          CALL  VERIFY        ; WAIT FOR ACK
  550.          CALL  BUMPNO
  551.          LDA   STYPE         ; CHECK FOR EOF
  552.          CPI   CHAR D
  553.          JZ    SLOOP         ; NO, STILL SENDING DATA
  554.          MVI   A,CHAR B      ; BREAK CONNECT
  555.          CALL  SPACK0
  556.          CALL  VERIFY        ; WAIT FOR ACK
  557.          JMP   RCVOK         ; DONE, SHOW MSG
  558.          EJECT
  559. *          ENCODE STRING AT (HL) OF LENGTH (A), AND SEND IT
  560. ENCSTR   MVI   B,0           ; JUST IN CASE
  561.          ORA   A             ; ANYTHING IN STRING?
  562.          JZ    SPACKC        ; NO, JUST SEND (TYPE ALREADY SET UP)
  563.          SHLD  SVBFP+1       ; SAVE PTRS
  564.          STA   SVBFL+1
  565. *          ENCODE DATA FOR SENDING
  566. MAKPAK   MVI   A,INSTR CNZ
  567.          STA   MAKEOF
  568. CXZ      MVI   A,0           ; INTERRUPT?
  569.          DCR   A
  570.          JP    DISC          ; YES, DISCARD
  571. SVBFP    LXI   H,0-0         ; SAVED INPUT PTR
  572. SVBFL    MVI   A,0-0         ; AND LENGTH REMAINING
  573.          LXI   D,SDAT        ; OUTPUT BUFFER
  574.          PUSH  D
  575. RBSIZ    EQU   *+1           ; MAX ALLOWED SEND
  576.          MVI   B,92
  577. MAKPL    ORA   A
  578.          JNZ   MAKPA1        ; USE IT
  579. EOFFL    JMP   MAKPZ         ; OR LXI D
  580.          PUSH  B
  581.          INR   A             ; SET 'NZ'
  582.          CALL  DCDOPR
  583.          POP   B
  584.          JNC   MAKPA1
  585.          MVI   A,INSTR JMP   ; HIT EOF
  586.          STA   EOFFL
  587.          XRA   A
  588.          JMP   FUL1          ; SEND LAST PACKET
  589. MAKPA1   MOV   C,A           ; SAVE LENGTH
  590. RQUO     EQU   *+1           ; QUOTE CHAR  (E)
  591. RQU8     EQU   *+2           ; 8-BIT QUOTE (D)
  592.          LXI   D,CHAR #:CHAR &
  593.          MVI   A,INSTR JNZ   ; DATA FOUND THIS BUFFER
  594.          STA   MAKEOF
  595.          MOV   A,M           ; GET NEXT BYTE
  596.          INX   H
  597.          CMP   M             ; AT LEAST 2?
  598.          DCX   H
  599.          JNZ   RPTZ          ; NO, FORGET IT
  600.          LDA   RPTQ          ; DOING REPEATS?
  601.          CMP   E
  602.          JZ    RPTZ          ; OFF IF SAME AS QUOTE
  603.          MOV   A,B           ; CHECK OUTPUT BUFFER
  604.          CPI   5
  605.          JC    RPTZ          ; NO ROOM
  606.          MOV   A,C           ; CHECK DATA LENGTH
  607.          ORA   A             ; 256?
  608.          JZ    SLP2          ; YES, LONG
  609.          CPI   4
  610.          JC    RPTZ          ; NOT WORTH IT
  611. SLP2     PUSH  B             ; SAVE CURRENT COUNT
  612.          MVI   A,94          ; MAX RPT COUNT
  613.          INR   C
  614.          DCR   C
  615.          JZ    SLIM          ; 256
  616.          CMP   C
  617.          JNC   *+4
  618. SLIM     MOV   C,A
  619.          PUSH  B
  620.          MOV   A,M           ; GET CHAR AGAIN
  621. RPTL     INX   H
  622.          DCR   C
  623.          JZ    RPTX          ; END, TALLY UP
  624.          CMP   M             ; STILL MATCHING?
  625.          JZ    RPTL
  626. RPTX     XTHL                ; GET OLD #
  627.          MOV   A,C
  628.          SUB   L             ; -(REPEAT COUNT)
  629.          POP   H
  630.          XTHL                ; STARTING COUNT
  631.          CPI   -3            ; WORTH IT?
  632.          JC    RPTY          ; YES, DO IT
  633.          MOV   C,L           ; NO, RESTORE PTRS
  634.          POP   H
  635.          ADD   L             ; BACK UP BUFFER PTR TO 1ST
  636.          MOV   L,A
  637.          JC    *+4
  638.          DCR   H
  639.          JMP   RPTZ          ; GIVE UP
  640. RPTY     STA   MRPTC+1       ; SAVE -(COUNT)
  641.          ADD   L             ; CORRECT FINAL COUNTER
  642.          MOV   C,A
  643.          INR   C
  644.          POP   H             ; -> 1ST NON-MATCH
  645.          DCX   H             ; LAST MATCH
  646.          XTHL                ; GET OUTPUT PTR
  647.          LDA   RPTQ          ; GET REPEAT PRFX
  648.          MOV   M,A           ; ADD TO BUFFER
  649.          INX   H
  650.          DCR   B
  651.          MVI   A,BL
  652. MRPTC    SUI   0-0           ; GET CHAR(COUNT)
  653.          MOV   M,A
  654.          INX   H
  655.          DCR   B
  656.          XTHL                ; BACK TO INPUT
  657. RPTZ     MOV   A,D           ; GET 8-BIT QUOTE
  658.          CMP   E             ; SAME AS QUOTE?
  659.          MOV   A,M           ; GET DATA CHAR
  660.          XTHL
  661.          JZ    TCHR          ; NO 8-BIT QUOTING
  662.          ORA   A
  663.          JP    TCHR          ; 8TH BIT OFF
  664.          DCR   B             ; SEE IF ROOM
  665.          JZ    FULL          ; NO, CLOSE PACKET NOW
  666.          DCR   B             ; MIGHT NEED 3
  667.          JZ    FULL
  668.          INR   B
  669.          MOV   M,D           ; INSERT QUOTE
  670.          INX   H
  671.          ANI   177Q
  672. TCHR     CMP   E             ; QUOTE?
  673.          JZ    SPECL         ; YES, SPECIAL CHAR
  674.          CMP   D             ; 8-BIT QUOTE?
  675.          JZ    SPECL
  676. RPTQ     EQU   *+1
  677.          CPI   CHAR ~        ; REPEAT PRFX?
  678.          JZ    SPECL
  679.          CPI   DEL
  680.          JZ    SPECX
  681.          CPI   BL
  682.          JNC   ADDIT         ; NORMAL CHAR
  683. SPECX    XRI   100Q          ; DECONTROLLIFY
  684. SPECL    DCR   B             ; SEE IF ROOM
  685.          JZ    FULL          ; NO, CLOSE OUT
  686.          MOV   M,E           ; YES, ADD QUOTE
  687.          INX   H
  688. ADDIT    MOV   M,A           ; ADD CHAR TO BUFFER
  689.          INX   H
  690.          XTHL                ; INPUT PTR
  691.          INX   H             ; USED IT
  692.          DCR   C
  693.          DCR   B             ; COUNT OUTPUT
  694.          MOV   A,C
  695.          JZ    FUL1          ; FILLED BUFFER
  696.          ORA   A             ; ANY MORE DATA?
  697.          JNZ   MAKPL         ; YES, KEEP GOING
  698.          LDA   STYPE
  699.          CPI   CHAR D        ; SENDING FILE?
  700.          JNZ   FUL2          ; NO, ASSUME JUST A STRING
  701.          MOV   A,B
  702.          CPI   3             ; MUCH ROOM?
  703.          MOV   A,C
  704.          JNC   MAKPL         ; ENOUGH ANYWAY
  705.          JMP   FUL1          ; NO, SEND IT OFF
  706. FULL     MOV   A,C           ; REMAINING COUNT
  707.          XTHL
  708. FUL1     CALL  SVBFS         ; SAVE PTR TO DATA
  709. FUL2     POP   H             ; OUTPUT PTR
  710.          MOV   A,L
  711.          SUI   SDAT>400Q     ; LENGTH
  712.          MOV   B,A           ; SET UP FOR SPACK
  713. MAKEOF   JNZ   SPACKC        ; OR 'CNZ'
  714. MAKPY    PUSH  H
  715. *          REACHED EOF
  716. MAKPZ    MVI   A,CHAR Z      ; SEND EOF
  717.          POP   D             ; FLUSH OUTPUT PTR
  718.          JMP   SPACK0
  719. *
  720. DISC     STC                 ; SIGNAL 'EOF'
  721.          CALL  DCDOPR
  722.          JMP   MAKPY
  723.          EJECT
  724. *          INPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN,
  725. *          'NZ,NC' => READ, 'C' => CLOSE
  726. *        ON EXIT: 'NC' => (HL)->BUFFER, (A)=LENGTH (MOD 256)
  727. *          'C' => REACHED EOF
  728. *
  729. *          TAPE INPUT
  730. TAPIN    JC    RDTEOF
  731.          JNZ   RDTAP
  732.          XRA   A
  733.          STA   TMPFB+3
  734.          LXI   H,$INOPN
  735.          LXI   D,TMPFB
  736.          CALL  FSYS          ; OPEN TAPE
  737.          CNZ   ERWR          ; GIVE UP
  738.          RET                 ; OK
  739. RDTAP    XRA   A
  740.          STA   TMPFBC        ; BUFFER LENGTH
  741.          LXI   D,TMPFB
  742.          LXI   H,$READ       ; READ OPR
  743.          CALL  FSYS
  744.          JNZ   RDTEOF        ; ASSUME EOF
  745.          LDA   TMPFBC        ; BYTE COUNT
  746.          LHLD  TMPFBB        ; BUFFER
  747.          RET
  748. RDTEOF   CPI   3
  749.          CNC   ERIO          ; TAPE ERROR
  750.          LXI   D,TMPFB
  751.          CALL  FBRLSE        ; FREE TAPE
  752.          STC
  753.          RET
  754. *
  755. *          INPUT FROM CORE
  756. RAMIN    RC
  757.          JNZ   RDRAM
  758.          LHLD  RAMD0         ; START OF FILE
  759. RDRAM    SHLD  SVBFP+1
  760.          PUSH  D
  761. RAMZ     LXI   D,RAMDSK      ; END OF FILE
  762.          MOV   A,E
  763.          SUB   L             ; AMOUNT LEFT
  764.          MOV   L,A
  765.          MOV   A,D
  766.          SBB   H
  767.          MOV   H,A
  768.          POP   D
  769.          RC                  ; PAST END??
  770.          ORA   L             ; ANY?
  771.          STC
  772.          RZ                  ; NONE, RETURN EOF
  773.          ORA   A             ; CLEAR 'C'
  774.          INR   H             ; AT LEAST 256?
  775.          DCR   H
  776.          LHLD  SVBFP+1       ; RETRIEVE CURRENT PTR
  777.          RZ                  ; LITTLE LEFT
  778.          XRA   A             ; LOTS LEFT
  779.          RET
  780.          EJECT
  781. *  SEND A PACKET
  782. SPACK0   MVI   C,0
  783. *  SEND A PACKET - ENTER HERE WITH (HL)->DATA, (C)=LENGTH, (A)=TYPE
  784. SPACK    LXI   D,STYPE
  785.          STAX  D             ; SAVE TYPE
  786.          INX   D
  787.          MOV   B,C           ; SAVE LENGTH
  788.          INR   C
  789.          DCR   C             ; ANY DATA?
  790.          CNZ   SYSCPY        ; YES, COPY IT
  791. *          HERE (B)=DATA LENGTH, BUFFER CONTAINS TYPE+DATA
  792. SPACKC   LDA   MARK
  793.          LXI   H,SPAKT
  794.          MOV   M,A           ; SET SYNCH MARK
  795.          INX   H
  796.          CALL  SPINT
  797.          INR   B
  798.          INR   B             ; COUNT SEQ,TYPE IN CHECKSUM
  799.          LDA   BLOCK         ; INCLUDE CHECK IN PACKET LENGTH
  800.          ADD   B
  801.          ADI   BL            ; GET CHAR(LEN)
  802.          MOV   M,A
  803.          MVI   C,0           ; CLEAR HIGH BYTE OF CHECK
  804. SPCHKL   INX   H
  805.          ADD   M             ; TALLY SUM
  806.          JNC   *+4
  807.          INR   C             ; BUMP HIGH BYTE
  808.          DCR   B
  809.          JNZ   SPCHKL
  810.          INX   H             ; PTR TO CHECK
  811.          XCHG                ; SAVE PTR
  812.          CALL  CHEK1         ; CONVERT TO 1-BYTE OR 2-BYTE CHECK
  813.          XCHG
  814.          MOV   M,A           ; SAVE IN BUFFER
  815.          INX   H
  816.          LDA   BLOCK
  817.          STA   SNDFL+1       ; INDICATE SOMETHING SENT
  818.          DCR   A
  819.          JZ    *+5           ; JUST ONE BYTE
  820.          MOV   M,C           ; SAVE OTHER BYTE
  821.          INX   H
  822. REOL     EQU   *+1           ; HIS END-OF-LINE
  823.          MVI   M,CR          ; OR WHATEVER
  824.          INX   H
  825.          MVI   M,0           ; END WITH NULL
  826. SPSND    CALL  RWAIT         ; OR LXI - WAIT FOR XON
  827.          LXI   D,SPAKT       ; WHOLE PACKET
  828. SPSLP    LDAX  D
  829.          INX   D
  830.          ORA   A
  831.          RZ
  832.          LXI   H,XPUTDC      ; XMIT CHAR
  833.          PUSH  H
  834.          RST   2
  835.          JMP   SPSLP         ; UP TO NULL
  836.          EJECT
  837. *          COMPUTE CHECK FROM (A) OR (A:C), CLOBBERS H,L,C
  838. CHEK1    MOV   L,A           ; LOW BYTE OF NUMBER
  839.          MOV   H,C           ; HIGH BYTE
  840.          MOV   C,A
  841.          LDA   BLOCK
  842.          DCR   A             ; ONE OR TWO?
  843.          JNZ   CHEK2
  844.          MOV   H,C
  845.          DAD   H             ; SHIFT 2 BITS
  846.          RAL
  847.          DAD   H
  848.          RAL
  849.          ADD   C
  850. CHEKR    ANI   77Q
  851.          ADI   BL            ; GET CHAR(CHECK)
  852.          RET
  853. CHEK2    DAD   H             ; COMPUTE 2-BYTE CHECK FROM (HL)
  854.          DAD   H
  855.          MOV   A,C           ; FRESH COPY OF LOW BYTE
  856.          ANI   77Q
  857.          ADI   BL            ; GET CHAR(LO-CHECK)
  858.          MOV   C,A           ; IN (C)
  859.          MOV   A,H
  860.          JMP   CHEKR         ; AND CHAR(LO-CHECK)
  861. *
  862. *          CHECK INTERRUPTS
  863. SPINT    LDA   CXZ+1
  864.          DCR   A
  865.          RM                  ; OK
  866.          MOV   C,A
  867.          LDA   STYPE
  868.          CPI   CHAR Y
  869.          JZ    SPINT1        ; MAKING AN ACK
  870.          MVI   C,CHAR D-CHAR X
  871.          CPI   CHAR Z
  872.          JZ    SPINT1        ; MAKING AN EOF
  873.          CPI   CHAR D
  874.          RNZ
  875.          MVI   B,0           ; MAKING DATA
  876.          MVI   A,CHAR Z      ; CHANGE TO EOF
  877.          STA   STYPE
  878. SPINT1   MOV   A,C           ; FLAG FOR X,Z,D
  879.          DCR   B
  880.          INR   B
  881.          RNZ                 ; ALREADY HAD THIS STUFF
  882.          INR   B             ; MUST ADD A BYTE FOR REJECTION
  883.          ADI   CHAR X
  884.          STA   SDAT
  885.          RET
  886.          EJECT
  887. *          WAIT FOR XON FROM HOST
  888. RWAIT    LXI   H,RTRN        ; TIMEOUT EXIT
  889.          CALL  TIMSET
  890. RWT1     CALL  GCH           ; GET CHAR
  891.          CPI   ESC
  892.          JZ    RWT2          ; SUPPRESS ESCAPES
  893.          PUSH  PSW
  894.          CALL  WCHAR         ; ECHO EVERYTHING
  895.          POP   PSW
  896. HNDSHK   EQU   *+1
  897. RWT2     CPI   XON
  898.          JNZ   RWT1          ; KEEP WAITING
  899.          RET
  900. *
  901. *          SET TIMEOUT EXIT
  902. TIMSET   SHLD  GCHTX+1
  903. IBM      EQU   *+1
  904.          MVI   A,INSTR CALL  ; OR LXI
  905.          STA   SPSND
  906.          RET
  907.          EJECT
  908. *          RECEIVE A PACKET
  909. RPACK    PUSH  D
  910.          LXI   H,RPBAK       ; TIMEOUT EXIT
  911.          CALL  TIMSET
  912. RP1      CALL  GCH           ; GET A CHAR
  913.          JZ    RBEG          ; FOUND MARK CHAR
  914.          CALL  WCHAR
  915.          JMP   RP1
  916. RBEG     CALL  GCH           ; GET LENGTH CHAR
  917.          JZ    RBEG          ; ANOTHER MARK
  918.          MVI   D,0           ; CLEAR HIGH BYTE OF SUM
  919.          MOV   C,A           ; INIT LOW BYTE
  920. BLOCK    EQU   *+1
  921.          SUI   1
  922.          JM    RPRET         ; IMPOSSIBLE!?
  923.          SUI   42Q           ; MIN VALUE
  924.          JC    RPRET         ; IMPOSSIBLE
  925.          STA   RLEN          ; DATA LENGTH
  926.          MOV   B,A
  927.          INR   B             ; ALSO COUNT SEQ,TYPE
  928.          INR   B
  929.          LXI   H,BUF
  930. RLP      CALL  GCH
  931.          JZ    RBEG          ; START OVER
  932.          CPI   BL            ; CTL?
  933.          JC    RPRET         ; NOT ALLOWED
  934.          MOV   M,A           ; ADD TO BUFFER
  935.          ADD   C             ; KEEP SUM
  936.          MOV   C,A
  937.          JNC   *+4
  938.          INR   D             ; PROPAGATE CARRY
  939.          INX   H
  940.          DCR   B
  941.          JNZ   RLP
  942.          MVI   M,0           ; END OF PACKET
  943.          MOV   C,D
  944.          CALL  CHEK1         ; DONE, GET CHECK
  945.          MOV   D,A           ; SAVE LOW BYTE
  946.          CALL  GCH           ; GET CHECK FOR PACKET
  947.          JZ    RBEG          ; I DON'T BELIEVE IT
  948.          CMP   D             ; MATCH?
  949.          JNZ   RPRET         ; TOO BAD
  950.          LDA   BLOCK
  951.          DCR   A
  952.          JZ    RPRET         ; 1-BYTE, OK (CC='Z')
  953.          CALL  GCH           ; GET CHECK FOR PACKET
  954.          JZ    RBEG          ; I DON'T BELIEVE IT
  955.          CMP   C             ; MATCH?
  956. RPRET    MVI   A,CHAR N      ; INDICATE BAD PACKET
  957. RPBAK    LXI   H,RTYPE       ; PTR ON RETURN
  958.          POP   D             ; RESTORE
  959.          RZ                  ; OK
  960.          MOV   M,A           ; ERROR
  961.          RET
  962.          EJECT
  963. *          DECODE INFO
  964. DECODE   LXI   H,RDAT        ; DATA PTR
  965.          LDA   RLEN          ; DATA LENGTH
  966.          ORA   A             ; ANY?
  967.          MOV   C,A
  968.          LDA   SVBFL+1       ; ROOM FOR OUTPUT
  969.          MOV   B,A
  970.          XCHG
  971.          LHLD  SVBFP+1       ; OUTPUT PTR
  972.          RZ                  ; NO DATA
  973.          PUSH  H
  974.          LHLD  RQUO          ; GET QUOTE, 8-BIT
  975.          XCHG
  976. *          (HL)->INPUT, (C)=INPUT LENGTH, (B)=OUTPUT ROOM
  977. *          (D)=8-BIT, (E)=QUOTE,  OUTPUT PTR ON STACK
  978. DCDL     LDA   RPTQ          ; RPT PRFX
  979.          CALL  TQCH          ; SEE IF ANY
  980.          MVI   A,0           ; NO REPEATS
  981.          JZ    DCDR
  982.          MOV   A,M           ; GET RPT COUNT
  983.          SUI   BL+1          ; CONVERT
  984.          CC    ERRP          ; BAD COUNT
  985.          CALL  IINP          ; GOBBLE
  986. DCDR     STA   RPTCT         ; SAVE COUNT
  987.          MOV   A,D           ; SEE IF 8-BIT
  988.          CALL  TQCH
  989.          MVI   A,200Q        ; PARITY BIT IF SO
  990.          JNZ   *+4
  991.          XRA   A             ; NOT
  992.          STA   STPR+1        ; SAVE
  993.          MOV   A,E
  994.          CALL  TQCH1         ; SEE IF QUOTE
  995.          MOV   A,M
  996.          JZ    STPR          ; NO, USE CHAR
  997.          CMP   E             ; QUOTE-QUOTE?
  998.          JZ    STPR          ; SPECIAL CHARS, OK
  999.          CMP   D
  1000.          JZ    STPR
  1001.          LDA   RPTQ
  1002.          CMP   M
  1003.          JZ    STPR
  1004.          MOV   A,M
  1005.          XRI   100Q          ; CONTROLLIFY
  1006. STPR     ORI   0-0           ; SET PARITY BIT
  1007.          XTHL                ; GET OUTPUT PTR
  1008. DCDO     MOV   M,A           ; ADD TO OUTPUT
  1009.          INX   H
  1010.          DCR   B             ; FULL?
  1011.          JZ    DCDW          ; YES, WRITE IT
  1012.          CPI   LF            ; CHECK FOR RECORDS
  1013.          JNZ   DCDY          ; NO
  1014. PREV     EQU   *+1           ; PREVIOUS CHAR
  1015.          MVI   A,0-0
  1016.          CPI   CR            ; PRECEDED BY CR?
  1017.          MVI   A,LF
  1018.          JNZ   DCDY          ; NO, OK
  1019. *          WRITE OUT
  1020. DCDW     PUSH  PSW           ; SAVE CURRENT CHAR
  1021.          ORI   1             ; SET CC='NZ,NC'
  1022.          CALL  DCDOPR        ; WRITE FULL BUFFER
  1023.          POP   PSW
  1024. DCDY     STA   PREV
  1025. RPTCT    EQU   *+1           ; REPEAT COUNT
  1026.          MVI   A,0-0
  1027.          DCR   A             ; ANY MORE?
  1028.          JM    DCDZ          ; NO
  1029.          STA   RPTCT         ; KEEP COUNTING
  1030.          LDA   PREV
  1031.          JMP   DCDO          ; DO IT AGAIN
  1032. DCDZ     XTHL
  1033.          INX   H
  1034.          DCR   C             ; INPUT DONE?
  1035.          JNZ   DCDL          ; NO, KEEP COPYING
  1036.          POP   H             ; RECOVER OUTPUT PTR
  1037.          MOV   A,B
  1038.          JMP   SVBFS         ; SAVE FOR NEXT TIME
  1039. *
  1040. *          CHECK DATA FOR PREFIX IN (A).  IF NOT, RETURN 'Z'
  1041. *          IF SO, GOBBLE CHAR AND RETURN 'NZ'
  1042. TQCH     CMP   E             ; SAME AS QUOTE?
  1043.          RZ                  ; NOT IN USE
  1044. TQCH1    CMP   M             ; FOUND ONE?
  1045.          JNZ   RETZ          ; NO, RETURN
  1046. IINP     INX   H             ; ADVANCE INPUT PTR
  1047.          DCR   C             ; CHAR USED UP
  1048.          CZ    ERQU          ; BROKEN STRING
  1049.          RET
  1050. RETZ     XRA   A             ; SET 'Z'
  1051.          RET
  1052.          EJECT
  1053. *          FIRST RESET CXZ FLAG
  1054. SETDCDX  XRA   A
  1055.          STA   CXZ+1
  1056. *          (HL)->ROUTINE, (DE)->BUFFER, (A)=LENGTH
  1057. SETDCD   SHLD  DCDOPR+1      ; SET OUTPUT ROUTINE
  1058.          XCHG
  1059.          CMP   A             ; SET CC='Z'
  1060. DCDOPR   JMP   0-0
  1061. *
  1062. *          OUTPUT ROUTINES -- ON ENTRY: 'Z,NC' => OPEN,
  1063. *          'NZ,NC' => WRITE, 'Z,C' => DUMP+CLOSE  (HL)->END+1
  1064. *        ON EXIT, (HL)->BUFFER, (B)=LENGTH (MOD 256)
  1065. *
  1066. *          OUTPUT TO TAPE
  1067. TAPOUT   JC    TAPEOF
  1068.          JNZ   WRTAP         ; WRITE RECORD
  1069.          CALL  FBSET         ; OPEN OUTPUT
  1070.          CNZ   ERWR          ; NOT AVAILABLE
  1071. TAPST1   LHLD  OUTFBB        ; TAPE BUFFER
  1072.          XRA   A
  1073. SVBFS    SHLD  SVBFP+1       ; OUTPUT PTR
  1074.          STA   SVBFL+1
  1075.          RET
  1076. TAPEOF   CALL  BUFCHK        ; DUMP BUFFER
  1077.          MVI   A,1           ; SET FOR CTL
  1078.          STA   OUTFB+3
  1079.          MVI   A,5           ; TAPE MARK
  1080.          STA   OUTFBC+1
  1081.          LXI   H,$CNTRL      ; CONTROL OPERATION
  1082.          CALL  FSYSO
  1083.          LXI   D,OUTFB
  1084.          JMP   FBRLSE        ; FREE TAPE
  1085. *          (HL)->END OF FILLED BUFFER, (B)=REMAINING ROOM
  1086. WRTAP    PUSH  B             ; WRITE TAPE RECORD
  1087.          PUSH  D
  1088.          MOV   A,L
  1089.          LHLD  OUTFBB        ; BUFFER PTR
  1090.          SUB   L             ; GET LENGTH
  1091.          STA   OUTFBC
  1092.          LXI   H,$WRITE      ; WRITE ROUTINE
  1093.          CALL  FSYSO         ; DO IT
  1094.          CNZ   ERIO          ; TOO BAD
  1095.          POP   D
  1096.          POP   B
  1097. WRTZ     LHLD  OUTFBB        ; NEW OUTPUT PTR
  1098.          MVI   B,0
  1099.          RET
  1100.          EJECT
  1101. *          OUTPUT TO SHORT BUFFER
  1102. BUFOUT   JZ    SVBFS         ; SETUP - ADR,LEN IN HL,A
  1103.          POP   D             ; JUST RETURN WHEN FILLED
  1104.          POP   D
  1105.          RET
  1106. *
  1107. *          OUTPUT TO LONG CORE BUFFER
  1108. RAMOUT   JC    RAMEOF
  1109.          JNZ   WRTRAM        ; WRITE RECORD
  1110.          LXI   H,FILMS2      ; COPY FILE NAME+LENGTH
  1111.          LXI   D,FNM
  1112.          MVI   C,FNML
  1113. FNMLT    MVI   A,1           ; SET BY INPUT
  1114.          CMP   C
  1115.          JC    *+4
  1116.          MOV   A,C           ; MAX LENGTH
  1117.          STA   FNMLEN
  1118.          CALL  SYSCPY
  1119.          LHLD  RAMD0         ; BIG BUFFER
  1120.          XRA   A
  1121.          JMP   SVBFS         ; SET UP PTRS
  1122. RAMEOF   LHLD  SVBFP+1       ; END OF DATA
  1123.          SHLD  RAMZ+1        ; SAVE
  1124.          RET
  1125. WRTRAM   MVI   B,0           ; ALLOW FULL 256 BUFFER
  1126.          INR   H             ; TEST FOR OVF
  1127.          DCR   H
  1128.          RP                  ; OK
  1129.          CALL  RAMEOF        ; SAVE END PTR
  1130.          CALL  ERIO
  1131. *
  1132. *          OUTPUT TO SCREEN
  1133. SCRNOUT  JC    BUFCHK
  1134.          JZ    TAPST1        ; SET PTRS
  1135.          MVI   M,0           ; MARK END
  1136.          LHLD  OUTFBB
  1137.          CALL  PSTR          ; DISPLAY IT
  1138.          JMP   WRTZ
  1139. *          DUMP BUFFER IF NOT EMPTY
  1140. BUFCHK   LDA   SVBFL+1       ; ANYTHING IN BUFFER?
  1141.          LHLD  SVBFP+1
  1142.          ORA   A
  1143.          JNZ   DCDOPR        ; YES, DUMP IT
  1144.          RET
  1145.          EJECT
  1146. *          ANALYZE INIT PARMS
  1147. GETPRM   LDA   RLEN          ; DATA LENGTH
  1148.          MOV   B,A
  1149.          LXI   H,RDAT
  1150.          CALL  GETOP         ; BUFFER LENGTH
  1151.          SUI   BL
  1152.          JZ    MAXBF         ; DEFLT
  1153.          CPI   26            ; MIN
  1154.          JNC   *+6           ; OK
  1155.          LDA   *-4           ; USE MIN
  1156.          CPI   96            ; MAX
  1157.          JC    *+6           ; OK
  1158. MAXBF    LDA   *-4           ; USE MAX
  1159.          SUI   6             ; ENVELOPE: MARK,LEN,SEQ,TYPE + CHECK
  1160.          STA   RBSIZ
  1161.          CALL  GETOP         ; TIME
  1162. TIMER    EQU   *+1
  1163.          MVI   C,INSTR JZ
  1164.          SUI   BL
  1165.          JNC   *+6
  1166.          XRA   A             ; DON'T
  1167.          MVI   C,INSTR JC    ; DISABLE TIMER
  1168.          ADD   A             ; X 4
  1169.          JC    MAXT          ; TOO BIG
  1170.          ADD   A
  1171.          JNC   SAVT
  1172. MAXT     XRA   A
  1173. SAVT     STA   RTIM
  1174.          MOV   A,C
  1175.          STA   TIMER1
  1176.          CALL  GETOP         ; SKIP NPAD
  1177.          CALL  GETOP         ; PAD CHAR
  1178.          CALL  GETOP         ; EOL
  1179.          SUI   BL
  1180.          JZ    DFLTEOL
  1181.          CPI   BL            ; MUST BE CONTROL
  1182.          JC    *+5           ; OK
  1183. DFLTEOL  MVI   A,CR
  1184.          STA   REOL
  1185.          CALL  GETOP         ; QUOTE CHAR
  1186.          MVI   C,CHAR #      ; DEFAULT
  1187.          CALL  CKQC          ; VALIDATE
  1188.          STA   RQUO
  1189.          MOV   C,A           ; SAVE (AND RETURN)
  1190.          LDA   SQU8          ; 8-BIT
  1191.          MOV   E,A           ; ALSO SAVE
  1192.          CALL  GETOP         ; 8-BIT QUOTE
  1193.          CALL  CKQ8          ; VALIDATE HIM
  1194.          MOV   D,A           ; SWAP
  1195.          MOV   A,E
  1196.          MOV   E,D
  1197.          CALL  CKQ8          ; VALIDATE ME
  1198.          CMP   E             ; AGREE?
  1199.          JZ    *+4           ; YES, OK
  1200.          MOV   A,C           ; NO, TURN OFF
  1201.          STA   RQU8
  1202.          CALL  GETOP         ; BLOCK CHECK
  1203.          CALL  CKBKC         ; VALIDATE IT
  1204.          MOV   D,A
  1205.          LDA   BKTP
  1206.          CMP   D             ; DO WE AGREE?
  1207.          CNZ   CKBK1         ; NO, USE '1'
  1208.          SUI   CHAR 0        ; CONVERT TO BINARY
  1209.          STA   BCTN+1        ; AND SAVE
  1210.          CALL  GETOP         ; REPEAT PRFX
  1211.          CPI   41Q
  1212.          JC    NRPT          ; INVALID
  1213.          CPI   DEL
  1214.          JNC   NRPT          ; NOPE
  1215.          CMP   E             ; DUPLICATE?
  1216.          JNZ   *+4           ; OK
  1217. NRPT     MOV   A,C           ; TURN OFF
  1218.          STA   RPTQ
  1219.          RET
  1220. *
  1221. *          FETCH PARAMETER BYTE (OR BLANK IF NONE)
  1222. GETOP    MVI   A,BL          ; DEFAULT
  1223.          DCR   B             ; ANY MORE DATA?
  1224.          RM                  ; NO, USE DEFAULT
  1225.          MOV   A,M           ; YES, GET IT
  1226.          INX   H
  1227.          RET
  1228. *
  1229. *          VALIDATE QUOTE CHAR IN (A), DFLT=(C)
  1230. CKQ8     CPI   CHAR Y        ; SPECIAL MEANING FOR 8-BIT
  1231.          JNZ   CKQC
  1232.          MOV   A,E           ; USE OTHER'S
  1233. CKQC     CPI   41Q           ; MUST BE PRINTABLE
  1234.          JC    DFQC          ; NO
  1235.          CPI   77Q           ; NOT UPCASE
  1236.          RC                  ; OK
  1237.          CPI   140Q
  1238.          JC    DFQC
  1239.          CPI   DEL
  1240.          RC                  ; OK
  1241. DFQC     MOV   A,C           ; DEFAULT
  1242.          RET
  1243. *
  1244. *          VALIDATE BLOCK-CHECK IN (A)
  1245. CKBKC    CPI   CHAR 2        ; ONLY ALTERNATIVE TO '1'
  1246.          RZ                  ; OK
  1247. CKBK1    MVI   A,CHAR 1      ; DEFAULT IS 1
  1248.          RET
  1249.          EJECT
  1250. *          GET CHAR FROM DATACOMM
  1251. GCH      PUSH  B             ; SAVE REGS
  1252.          PUSH  D
  1253.          PUSH  H
  1254. RTIM     EQU   *+2           ; TIME OUT PERIOD
  1255.          LXI   H,0
  1256.          PUSH  H             ; TIMEOUT COUNTER
  1257. GCHL     POP   H
  1258.          DCX   H             ; COUNT LOOPS
  1259.          MOV   A,H
  1260.          ORA   L             ; RUN DOWN?
  1261. TIMER1   JZ    TIMEOUT       ; OR 'JC' TO DISABLE
  1262.          PUSH  H
  1263.          CALL  CKXZ          ; SEE IF INTERRUPT
  1264.          LXI   H,GETDC
  1265.          PUSH  H
  1266.          RST   2             ; GET CHAR
  1267.          JZ    GCH9          ; GOT ONE
  1268.          LDA   KBSTT
  1269.          CMA                 ; CHECK FOR CNTL+SHIFTS
  1270.          ANI   31Q           ; ALL?
  1271.          JNZ   GCHL          ; NO, CHECK AGAIN
  1272.          CALL  SCRBOT        ; INTERRUPT
  1273. GTKL     CALL  WAITU         ; READ KBD
  1274.          ORA   A             ; CHECK FOR FUNCTIONS
  1275.          JM    GTKW          ; DON'T SEND THEM
  1276.          LXI   H,XPUTDC
  1277.          PUSH  H
  1278.          RST   2             ; SEND
  1279. GTKW     CPI   CR
  1280.          JZ    GCHL          ; NOW TRY AGAIN
  1281.          CALL  WCHAR
  1282.          JMP   GTKL
  1283. GCH9     POP   H             ; FLUSH COUNTER
  1284.          POP   H
  1285.          POP   D
  1286.          POP   B
  1287. MARK     EQU   *+1
  1288.          CPI   1             ; SYNCH
  1289.          RET
  1290. TIMEOUT  LXI   H,8           ; HOST IS STALLED
  1291.          DAD   SP            ; FLUSH SAVED STUFF
  1292.          SPHL
  1293.          MVI   A,CHAR T      ; INDICATE TIMEOUT
  1294.          ORA   A             ; SET 'NZ'
  1295. GCHTX    JMP   0-0
  1296. *
  1297. *          CHECK FOR INTERRUPT
  1298. CKXZ     LXI   H,GTKEY
  1299.          PUSH  H
  1300.          RST   2
  1301.          RNZ                 ; OK, NOTHING TYPED
  1302.          SUI   CHAR X-100Q   ; CTL-X?
  1303.          JZ    *+6           ; YES, THAT'S IT
  1304.          CPI   CHAR Z-CHAR X ; CTL-Z?
  1305.          RNZ
  1306.          INR   A
  1307.          STA   CXZ+1         ; SAVE FLAG
  1308.          RET
  1309.          EJECT
  1310. *          SEND ZERO-LENGTH ACK
  1311. ACK0     MVI   A,CHAR Y      ; ACK
  1312.          CALL  SPACK0        ; SEND IT AND THEN ...
  1313. *          ADVANCE RECORD NUMBER
  1314. BUMPNO   LDA   SSEQ
  1315.          SUI   37Q
  1316.          ANI   77Q
  1317.          ADI   BL
  1318.          STA   SSEQ          ; UPDATE
  1319.          CPI   BL+10
  1320.          JNZ   *+8
  1321.          MVI   A,BEL         ; SET TO BEEP AFTER TRANSFER
  1322.          STA   XFLEN
  1323.          LXI   D,RCNOLN:TABCOL
  1324. RECCT    LXI   H,0           ; COUNTER
  1325.          INX   H
  1326.          SHLD  RECCT+1
  1327. *          PRINT (HL) AT (D/E) ON SCREEN
  1328. SCRNO    PUSH  H             ; SAVE NUM
  1329.          LHLD  CRSPOS        ; SAVE POSITION
  1330.          XCHG
  1331.          CALL  CLRLH
  1332.          POP   H
  1333.          CALL  PNUM
  1334.          XCHG
  1335.          JMP   SETCRS        ; RESTORE POSITION
  1336. *
  1337. *          READ DECIMAL NUMBER FROM KEYBOARD INTO (HL), BREAK IN (A)
  1338. GETNUM   LXI   H,0           ; INIT
  1339. GETNL    CALL  WAITU
  1340.          CPI   CHAR 0        ; VALID DIGIT?
  1341.          RC                  ; NO, THAT'S IT
  1342.          CPI   CHAR 9+1
  1343.          RNC
  1344.          SUI   CHAR 0        ; CONVERT TO BINARY
  1345.          PUSH  D             ; SAVE REGS
  1346.          MOV   D,H
  1347.          MOV   E,L           ; COPY LAST VALUE
  1348.          DAD   H
  1349.          DAD   H
  1350.          DAD   D             ; x 5
  1351.          DAD   H             ; x 10
  1352.          MOV   E,A           ; NEW DIGIT
  1353.          MVI   D,0
  1354.          DAD   D
  1355.          POP   D
  1356.          JMP   GETNL         ; KEEP READING
  1357.          EJECT
  1358. *          ESTABLISH NEW STATE, THEN WAIT FOR GOOD PACKET
  1359. VERIFYP  SHLD  VERPTR+1
  1360. VERIFY   POP   H
  1361.          SHLD  VERRET+1      ; SET RETURN ADR
  1362. RETRY    EQU   *+1
  1363.          MVI   A,10          ; MAX TRIES
  1364.          STA   TRIES
  1365. VER1     CALL  RPACK
  1366.          MOV   A,M           ; GET TYPE
  1367.          CPI   CHAR N        ; MAYBE NAK
  1368.          JZ    AGAIN
  1369.          CPI   CHAR T        ; MAYBE TIMEOUT
  1370.          JZ    AGAIN
  1371.          CPI   CHAR E        ; MAYBE ERROR
  1372.          CZ    OOPSE
  1373.          DCX   H             ; PTR TO REC NO
  1374.          LDA   SSEQ          ; LAST SENT
  1375.          CMP   M             ; MATCH?
  1376.          JNZ   VERBAD        ; NO, TRY AGAIN
  1377.          INX   H             ; OK
  1378.          MOV   A,M           ; RETRIEVE TYPE
  1379. VERPTR   LXI   H,*-*
  1380.          MOV   E,M           ; GET PTR TO END OF LIST
  1381.          INX   H
  1382.          MOV   D,M
  1383.          INX   H
  1384.          STAX  D             ; INSERT GUARD
  1385.          JMP   CMDSP
  1386. *
  1387. VERBAD   MVI   A,CHAR K      ; BAD REC NO
  1388. AGAIN    CALL  BUMPT
  1389.          LXI   H,VER1
  1390.          PUSH  H             ; SET 'RETURN' ADR
  1391. SNDFL    MVI   A,CHAR N
  1392.          CPI   CHAR N        ; ANYTHING SENT YET
  1393.          JZ    SPACK0        ; NO, SEND NAK
  1394.          JMP   SPSND         ; RESEND
  1395. *
  1396. VERACK   LDA   RLEN          ; GOT ACK
  1397.          DCR   A             ; ANY DATA?
  1398.          JNZ   VERRET
  1399.          LDA   RDAT          ; GET ONE-AND-ONLY
  1400.          SUI   CHAR X-1      ; X OR Z?
  1401.          JC    VERRET
  1402.          STA   CXZ+1         ; YES, THAT'S IT FOLKS
  1403. VERRET   JMP   *-*
  1404. *
  1405. *          COUNT RETRIES
  1406. BUMPT    STA   ECODEB        ; TYPE OF ERROR
  1407.          LXI   H,TRIES
  1408.          DCR   M
  1409.          CZ    ERTR          ; RAN OUT
  1410. RTRCT    LXI   H,0
  1411.          INX   H
  1412. PRTRY    SHLD  RTRCT+1       ; ENTER HERE WITH NEW RETRY TOTAL
  1413.          LXI   D,RTRYLN:TABCOL
  1414.          JMP   SCRNO
  1415.          EJECT
  1416. *          INITIAL STATE FOR RECEIVE
  1417. RCVSTI   DW    RCVSTIZ       ; END OF LIST
  1418.          DB    CHAR S        ; SEND-INIT
  1419.           DW   VERRET
  1420. RCVSTIZ  DS    1
  1421.           DW   ERTP
  1422. *          RECEIVE WAITING FOR FILE HEADER
  1423. RCVSTH   DW    RCVSTHZ       ; END OF LIST
  1424.          DB    CHAR F        ; DISK FILE
  1425.           DW   VERRET
  1426.          DB    CHAR X        ; DISPLAY FILE
  1427.           DW   VERRET
  1428.          DB    CHAR B        ; BREAK CONNECTION
  1429.           DW   RCVBRK
  1430. RCVSTHZ  DS    1
  1431. *          RECEIVE WAITING FOR DATA
  1432. RCVSTD   DW    RCVSTDZ       ; END OF LIST
  1433.          DB    CHAR D        ; DATA PACKET
  1434.           DW   VERRET
  1435.          DB    CHAR Z        ; END OF FILE
  1436.           DW   RCVEOF
  1437. RCVSTDZ  DS    1
  1438.           DW   ERTP
  1439. *          SENDING FILE
  1440. SNDST    DW    SNDSTZ        ; END OF LIST
  1441.          DB    CHAR Y        ; ACK IS ONLY ALLOWED
  1442.           DW   VERACK
  1443. SNDSTZ   DS    1
  1444.           DW   ERTP
  1445. *          SENDING SERVER COMMAND
  1446. CMDST    DW    CMDSTZ        ; END OF LIST
  1447.          DB    CHAR Y        ; ACK
  1448.           DW   VERACK
  1449.          DB    CHAR S        ; LONG REPLY (IF ALLOWED)
  1450.           DW   RCV2
  1451. CMDSTZ   DS    1
  1452.           DW   ERTP
  1453.          EJECT
  1454. *          ERROR HANDLER
  1455. OOPSE    LXI   H,EMSGLN:TABCOL-7
  1456.          CALL  PCRS
  1457.          ASCC  'Error: '
  1458.          LXI   H,RDAT
  1459.          CALL  PSTR          ; DISPLAY MESSAGE
  1460.          CALL  PEMSG
  1461.          ASCC  'Remote host aborted'
  1462. *
  1463. OOPS     POP   D             ; MSG PTR
  1464.          POP   H             ; ERROR ADR
  1465.          SHLD  ERADR
  1466.          XCHG
  1467.          MOV   C,M           ; GET LENGTH
  1468.          INX   H
  1469.          PUSH  H
  1470.          MVI   A,CHAR E      ; ERROR PACKET
  1471.          CALL  SPACK
  1472. PEMSG    CALL  BEEPM         ; MESSAGE SET UP
  1473.          POP   H
  1474.          CALL  PSTR          ; DISPLAY
  1475. RSTSP    LXI   SP,0-0        ; ABORT
  1476.          JMP   WAITING
  1477. *
  1478. *          INDIVIDUAL ERRORS
  1479. ERAK     CALL  OOPS
  1480.          DB    ERAKL
  1481.          ASCC  'Bad INIT data'
  1482. ERAKL    EQU   *-ERAK-5
  1483. ERIO     CALL  OOPS
  1484.          DB    ERIOL
  1485.          ASCC  'I/O error'
  1486. ERIOL    EQU   *-ERIO-5
  1487. EROTH    CALL  OOPS
  1488.          DB    EROTHL
  1489.          ASCC  'Unknown error'
  1490. EROTHL   EQU   *-EROTH-5
  1491. ERQU     CALL  OOPS
  1492.          DB    ERQUL
  1493.          ASCC  'Split prefix'
  1494. ERQUL    EQU   *-ERQU-5
  1495. ERRP     CALL  OOPS
  1496.          DB    ERRPL
  1497.          ASCC  'Bad repeat count'
  1498. ERRPL    EQU   *-ERRP-5
  1499. ERTP     CALL  OOPS
  1500.          DB    ERTPL
  1501.          ASCC  'Bad packet type'
  1502. ERTPL    EQU   *-ERTP-5
  1503. ERTR     CALL  OOPS
  1504.          DB    ERTRL
  1505.          ASCC  'Retry limit - ',-  ; N=> NAK OR BAD PACKET, T=> TIMEOUT
  1506. ECODEB   DB    0,0                 ; K=> BAD PACKET NUMBER
  1507. ERTRL    EQU   *-ERTR-5            ; OTHER=> BAD PACKET TYPE
  1508. ERWR     CALL  OOPS
  1509.          DB    ERWRL
  1510.          ASCC  'No local storage'
  1511. ERWRL    EQU   *-ERWR-5
  1512.          EJECT
  1513. *          EXIT TO TERMINAL MONITOR
  1514. EXIT     MVI   B,1
  1515.          CALL  SWNDW
  1516.          CALL  SCRBOT
  1517.          CALL  PSTRLOC
  1518.          ASCC  'TERMINAL READY'013010''
  1519. RETAD    JMP   0-0
  1520. *
  1521. *          OPEN A FILE FOR OUTPUT
  1522. FBSET    LXI   H,OUTFB+3     ; PTR TO FILE BLOCK
  1523.          MVI   M,3
  1524.          LXI   H,$OUTOPN
  1525. FSYSO    LXI   D,OUTFB       ; FB PTR
  1526.          JMP   FSYS
  1527. *          CLOSE A FILE
  1528. FBRLSE   LXI   H,$CLOSE      ; SYS CLOSE
  1529.          LDAX  D             ; CHECK CODE
  1530.          ORA   A
  1531.          RZ                  ; NOT ASSIGNED, SKIP IT
  1532. *          DO IT
  1533. FSYS     PUSH  H
  1534.          XCHG                ; GET REQUESTED FB
  1535.          SHLD  FBPTR         ; SET UP FB
  1536.          MVI   A,2
  1537.          CALL  CALROM
  1538.          LHLD  FBPTR
  1539.          INX   H
  1540.          MOV   A,M           ; GET RET CODE
  1541.          ORA   A
  1542.          RET
  1543. *
  1544. *        SOUND BELL, THEN POSITION CURSOR TO MESSAGE FIELD
  1545. BEEPM    LXI   H,BELL
  1546.          PUSH  H
  1547.          RST   2
  1548. MSGS     LXI   H,MSGLN:0
  1549. CLRLH    CALL  SETCRS        ; POSITION TO (HL)
  1550.          PUSH  H
  1551.          LXI   H,CLEARL      ; CLEAR LINE
  1552.          JMP   EXRST2
  1553. *
  1554. *          HOME CURSOR
  1555. CRS00    LXI   H,0
  1556. *          MOVE CURSOR TO HL=ROW:COL
  1557. SETCRS   SHLD  CRSPOS        ; SET POS'N
  1558.          PUSH  H
  1559.          LXI   H,$CURPLC
  1560. EXRST2   PUSH  D
  1561.          PUSH  B
  1562.          MOV   C,A
  1563.          PUSH  H
  1564.          RST   2
  1565.          POP   B
  1566.          POP   D
  1567.          POP   H
  1568.          RET
  1569.          EJECT
  1570. *
  1571. *          DISPLAY WINDOW IN (B)
  1572. SWNDW    MVI   A,1
  1573.          LXI   H,$WINDW
  1574.          PUSH  H
  1575.          RST   2
  1576.          RET
  1577. *
  1578. *          READ, UPCASE A CHARACTER
  1579. WAITU    CALL  WAIT1
  1580.          JNZ   WAITU
  1581.          CPI   KRET          ; RETURN KEY
  1582.          JNZ   *+5
  1583.          MVI   A,CR
  1584. UPPER    CPI   96+27
  1585.          RNC
  1586.          CPI   96+1
  1587.          RC
  1588.          SUI   32
  1589.          RET
  1590. *          GET CHAR, IF ANY
  1591. WAIT1    PUSH  H
  1592.          LXI   H,GTKEY
  1593.          JMP   EXRST2
  1594.          EJECT
  1595. *          CONTROL BLOCKS, POINTERS
  1596. *
  1597. INDIC    LXI   H,1:TABCOL
  1598.          CALL  PCRS
  1599.          ASCC  'Btpp."8BR'
  1600.          LDA   LNAME
  1601.          STA   LNMS
  1602.          LDA   RNAME
  1603.          STA   RNMS
  1604. QUOTE    EQU   *+1
  1605.          MVI   A,CHAR #
  1606.          STA   SQUO          ; DEFAULT OPTION
  1607. DPTQ     EQU   *+1
  1608.          MVI   A,CHAR ~
  1609.          STA   SPTQ
  1610. BUFSZ    EQU   *+1
  1611.          MVI   A,94
  1612.          ADI   BL
  1613.          STA   SNITP
  1614. TIME     EQU   *+1
  1615.          MVI   A,3
  1616.          ADI   BL
  1617.          STA   STIM
  1618.          LXI   H,2:TABCOL-7
  1619.          CALL  PCRS          ; DISPLAY SET PARMS
  1620.          ASCC  'Parms: ',-
  1621. *          SEND INIT DATA
  1622. SNITP    DB    94+BL         ; BUFSIZ
  1623. STIM     DB    3+BL          ; TIMEOUT
  1624.          DB    0+BL          ; NPAD
  1625.          DB    100Q          ; PAD
  1626.          DB    CR+BL         ; EOL
  1627. SQUO     DB    CHAR #        ; QUOTE
  1628. SQU8     DB    CHAR Y        ; 8-BIT QUOTE
  1629. BKTP     DB    CHAR 1        ; CHECK TYPE
  1630. SPTQ     DB    CHAR ~        ; REPEAT PRFX
  1631. SNITL    EQU   *-SNITP
  1632.          ASCC  '  Src: ',-
  1633. LNMS     ASCC  '*  Dst: ',-
  1634. RNMS     DB    CHAR *
  1635.          DB    0             ; MARKS END OF STRING
  1636.          CALL  MSGS          ; SET UP MESSAGE FOR VALUES
  1637.          XRA   A
  1638.          STA   SNTBLZ        ; MARK END OF TABLE
  1639.          LXI   H,SNTBL
  1640. INDLP    MOV   A,M
  1641.          ORA   A             ; REACHED END?
  1642.          RZ                  ; YES
  1643.          CALL  WCHAR         ; NO, PRINT NEXT OPTION
  1644.          INX   H
  1645.          MOV   E,M           ; FETCH LOCATION
  1646.          INX   H
  1647.          MOV   D,M
  1648.          INX   H
  1649.          XCHG
  1650.          MOV   L,M           ; FETCH VALUE
  1651.          CALL  PNUM1
  1652.          MVI   A,BL
  1653.          CALL  WCHAR
  1654.          XCHG
  1655.          INX   H             ; SKIP OVER LIMITS
  1656.          INX   H             ; SKIP OVER LIMITS
  1657.          JMP   INDLP
  1658. *
  1659. *          DUMMY FILE NAME
  1660. SFN      ASCC  'A.B'
  1661. SFNL     EQU   *-SFN-1
  1662. FILMSG   ASCC  'File: ',-
  1663. FILMS2   DS    20
  1664. LFILM2   EQU   *-FILMS2-1
  1665. FNM      ASCC  'NULL.FILE'   ; INITIAL RAM NAME
  1666.          DS    15
  1667. FNML     EQU   *-FNM
  1668. FNMLEN   DB    9
  1669. *
  1670. RAMD0    DW    RAMDSK        ; START OF BUFFER
  1671. TRIES    DS    1             ; RETRY COUNTER
  1672. ERADR    DS    2             ; ERROR DETECTION ADR
  1673. *
  1674. *         SEND PACKET
  1675. SPAKT    DS    2             ; MARK, LENGTH
  1676. SSEQ     DS    1             ; PACKET NUMBER
  1677. STYPE    DS    1             ; RECORD TYPE
  1678. SDAT     DS    96
  1679. *          RECEIVE INFO
  1680. RLEN     DS    1             ; COUNT
  1681. BUF      DS    128
  1682. RTYPE    EQU   BUF+1
  1683. RDAT     EQU   BUF+2
  1684. *
  1685. *          OUTPUT FILE BLOCK
  1686. OUTFB    DB    0,0,0,3
  1687.          DW    RNAME
  1688. OUTFBB   DW    0
  1689. OUTFBC   DB    0,0
  1690. OUTFBA   DW    OUTARG
  1691.          DS    6
  1692. OUTARG   DS    3
  1693. RNAME    ASCC  'R'13''
  1694.          DS    6
  1695. *          INPUT FILE BLOCK
  1696. TMPFB    DB    0,0,0,3
  1697.          DW    LNAME
  1698. TMPFBB   DW    0
  1699. TMPFBC   DB    0,0
  1700.          DW    OUTARG
  1701.          DS    6
  1702. LNAME    ASCC  'L'13''
  1703.          DS    6
  1704.          EJECT
  1705. *          DISPLAY MESSAGE FROM IN-LINE
  1706. PMSG     CALL  MSGS
  1707.          JMP   PSTRLOC
  1708. PCRS     CALL  SETCRS        ; MOVE TO (HL)
  1709. PSTRLOC  XTHL                ; GET PTR
  1710.          CALL  PSTR
  1711.          XTHL
  1712.          RET
  1713. *          DISPLAY MESSAGE AT (HL)
  1714. PSTR     MOV   A,M
  1715.          INX   H
  1716.          ORA   A
  1717.          RZ                  ; STOP AT NULL
  1718.          CALL  WCHAR
  1719.          JMP   PSTR
  1720. *
  1721. *          WRITE CHARACTER FROM (A)
  1722. WCHAR    PUSH  H
  1723.          LXI   H,CHINT0
  1724.          JMP   EXRST2
  1725. *
  1726. *          DISPATCH FROM COMMAND LIST
  1727. CMDSP    CMP   M             ; COMPARE AGAINST TABLE
  1728.          INX   H
  1729.          MOV   E,M           ; FETCH COMMAND ADR
  1730.          INX   H
  1731.          MOV   D,M
  1732.          INX   H
  1733.          JNZ   CMDSP         ; KEEP LOOKING
  1734.          XCHG
  1735.          PCHL                ; GO DO IT
  1736. *
  1737. *          DISPLAY FROM (L)
  1738. PNUM1    MVI   H,0
  1739. *          DISPLAY DECIMAL NUMBER FROM (HL)
  1740. PNUM     PUSH  B             ; SAVE REGS.
  1741.          PUSH  D
  1742.          XCHG
  1743.          LXI   H,DECBUF
  1744.          PUSH  H
  1745.          LXI   H,BN2DEC
  1746.          XTHL
  1747.          RST   2             ; CONVERT TO STRING
  1748.          LXI   H,DECBUF
  1749.          CALL  PSTR
  1750.          POP   D
  1751.          POP   B
  1752.          RET
  1753.          END
  1754.