;       *** CompuServe Information Service Executive for CP/M (R)
;               (CP/M is a trademark of Digital Research)
;       Copyright (C) 1980, 1981 CompuServe Incorporated
;       Version 2.3
;       Written by:
;                       Russ Ranshaw


false:  equ     0
true:   equ     not false

usebios:        equ     false           ; true to use direct BIOS calls for
                                       ; console output
                       ;*** Note: If you choose to use BDOS call for console
                       ; write, AND have "shoxfr" true, you may not be able
                       ; to do file transfers if your communication channel
                       ; is operating at greater than 300 baud!
shoxfr: equ     true    ; true to show data during file transfer
sholcc: equ     09h     ; lowest displayable control character for console
shohcc: equ     0dh     ; highest "" (used in PRODSP to map ctl characters)
paglen: equ     60      ; printer page length

other:  equ     false   ; true if the computer is NOT one of the special ones
hz89:   equ     false   ; true if the computer is a Heath/Zenith 88, 89, 8
hz19:   equ     false           ; Console is a Heath/Zenith -19
pmmi    equ     true    ; true if PMMI modem board

       if      other
BBASE:  EQU     0000H   ; "PAGE 0" ADDRESS
CTL     EQU     03H     ; CONTROL PORT
SIO     EQU     01H     ; SIO PORT
SIOIR   EQU     40H     ; SIO PORT DATA INPUT READY FLAG
SIOTR   EQU     80H     ; SIO PORT TRANSMITTER READY FLAG
hitrue: equ     false   ; SIO flags are "hi" (1) when true
       endif

       if      hz89
bbase:  equ     4200h   ; "Page 0" Address - Set to 0 if you have 0 based CP/M
ctl:    equ     0ddh    ; Line Control Register
sio:    equ     0d8h    ; Receive/Transmit Data Register
sioir:  equ     01h     ; Receive Data Ready flag
siotr:  equ     20h     ; Transmitter Buffer Ready flag
hitrue: equ     true
       endif

       if      pmmi
bbase:  equ     0h      ; "Page 0" address
basprt: equ     0c0h    ; base i/o port address for pmmi board
ctl:    equ     basprt  ; primary control port
sio:    equ     basprt+1        ; serial data port
sioir:  equ     02h     ; data input ready flag
siotr:  equ     01h     ; transmitter ready flag
hitrue: equ     true    ; flags are high when true
       endif

; SPECIAL CHARACTERS FOR DATA TRANSMISSION PROTOCOL

SOH:    EQU     01H     ; START OF TEXT
ETX:    EQU     03H     ; END OF TEXT
EOT:    EQU     04H     ; END OF TRANSMISSION
ENQ:    EQU     05H     ; ^E, USED FOR PMMI EXIT W/O DISCONNECT
SI:     EQU     0FH     ; <SI> = SHIFT INTO PROTOCOL MODE
SO:     EQU     0EH     ; <SO> = SHIFT OUT OF PROTOCOL MODE]
                       ; PROTOCOL MODE IMPLIES THAT <ESC> SEQUENCES
                       ; ARE NOT SENT TO CONSOLE BUT ARE USED TO CONTROL
                       ; THE UP/DOWN LOAD PROTOCOL
DC1:    EQU     11H     ; <DC1> CONTROL-Q: RESUME TRANSMISSION
DC2:    EQU     12H     ; <DC2> CONTROL-R: PRINTER ON
DC3:    EQU     13H     ; <DC3> CONTROL-S: STOP TRANSMISSION
DC4:    EQU     14H     ; <DC4> CONTROL-T: PRINTER OFF
KNAK:   EQU     15H     ; <NAK>
DLE:    EQU     10H     ; <DLE> (TRANSPARACY FLAG)
ESC:    EQU     1BH     ; ESCAPE
EOF:    EQU     1AH     ; ^Z (CP/M END OF FILE)
CR:     EQU     0DH     ; <RET>
LF:     EQU     0AH     ; <LF>
FF:     EQU     0CH     ; <FF>
MON:    EQU     18H     ; ^X (RETURN TO CP/M) (& DISCONNECT PMMI)

; CP/M EQUATES

BDOS:   EQU     BBASE+0005H     ; MAIN ENTRY POINT FOR CP/M
TFCB:   EQU     BBASE+005CH     ; DEFAULT FILE CONTROL BLOCK
TBUFF:  EQU     BBASE+0080H     ; DEFAULT FILE BUFFER
TBASE:  EQU     BBASE+0100H     ; TRANSIENT BASE

; DEFINE OFFSETS INTO FILE CONTROL BLOCK (FCB)

FCB$ET: EQU     0       ; ENTRY TYPE
FCB$FN: EQU     1       ; FILE NAME (8 BYTES)
FCB$FT: EQU     9       ; FILE TYPE (3 BYTES)
FCB$RC: EQU     15      ; RECORD COUNT (CURRENT EXTENT)
FCB$DM: EQU     16      ; DISK MAP
FCB$NR: EQU     32      ; NEXT RECORD NUMBER TO READ OR WRITE

;       BDOS FUNCTIONS:

FN$SR:  EQU     0       ; SYSTEM RESET
FN$RC:  EQU     1       ; READ CONSOLE
FN$WC:  EQU     2       ; WRITE CONSOLE
FN$RR:  EQU     3       ; READ READER
FN$WP:  EQU     4       ; WRITE PUNCH
FN$WL:  EQU     5       ; WRITE LIST
FN$IS:  EQU     7       ; INTERROGATE I/O STATUS
FN$AS:  EQU     8       ; ALTER I/O STATUS
FN$PCB: EQU     9       ; PRINT CONSOLE BUFFER
FN$RCB: EQU     10      ; READ CONSOLE BUFFER
FN$CCS: EQU     11      ; CHECK CONSOLE STATUS
FN$LDH: EQU     12      ; LIFT DISK HEAD
FN$RDS: EQU     13      ; RESET DISK SYSTEM
FN$SD:  EQU     14      ; SELECT DISK
FN$OPN: EQU     15      ; OPEN FILE
FN$CLS: EQU     16      ; CLOSE FILE
FN$SF:  EQU     17      ; SEARCH FIRST
FN$SN:  EQU     18      ; SEARCH NEXT
FN$DEL: EQU     19      ; DELETE FILE
FN$RDR: EQU     20      ; READ DISK RECORD
FN$WDR: EQU     21      ; WRITE DISK RECORD
FN$CRE: EQU     22      ; CREATE FILE
FN$REN: EQU     23      ; RENAME FILE
FN$IL:  EQU     24      ; INTERROGATE LOGIN
FN$ID:  EQU     25      ; INTERROGATE DISK
FN$SDA: EQU     26      ; SET DMA ADDRESS
FN$IA:  EQU     27      ; INTERROGATE ALLOCATION

       ORG     TBASE

START:  JMP     START0          ; NORMAL START
INISIO: JMP     SIOINI          ; INITIALIZE MODEM UART
GETSIO: JMP     SIOGET          ; GET CHAR FROM MODEM UART
PUTSIO: JMP     SIOPUT          ; PUT A CHAR TO MODEM UART

; <ESC><I> response for this executive:

       if      other
SYSID:  DB      '#CPMTarbell,CC,HC,PA,PL',CR,00
       endif

       if      hz89
sysid:  db      '#CPMHeath/Zenith,CC,HC,PA,PL',cr,00
       endif

       if      pmmi
sysid:  db      '#CPMPMMI,CC,HC,PA,PL',CR,00
       endif

; CC = Cursor Control
;   Implies following cursor controls:
;       <ESC><A>        cursor up
;       <ESC><B>        cursor down
;       <ESC><C>        cursor right
;       <ESC><D>        cursor left
;       <ESC><H>        cursor home (line 1, column 1)
;       <ESC><J>        erase to end of screen
;       <ESC><K>        erase to end of line
;       <ESC><j>        erase screen and home cursor (also <FF>)
;       <ESC><Y><L+31><C+31> position cursor to line L column C
; HC = Hard Copy
;   Implies following:
;       <DC2> (^R, 022 octal, 12 hex) enable printer; subsequent data
;                                     will be copied to local printer
;       <DC4> (^T, 024 octal, 14 hex) disable printer
;       <ESC><e>        disable terminal display
;       <ESC><f>        enable terminal display
; PA = A Protocol
;    Implies file transfer capability using the CompuServe A protocol
; PL = Load Protocol
;    Implies ability to load code segments under the CompuServe L protocol

banner: db      'CompuServe CP/M (R) Executive Version 2.3',cr,lf
       if      other
       db      '**** Tarbell/Z-80 ****',cr,lf,0
       endif

       if      hz89
       db      '**** Heath/Zenith ****',cr,lf,0
       endif

       if      pmmi
       db      '**** PMMI Modem ****',cr,lf
       db      '^E exit WITHOUT disconnect, ^X exit WITH disconnect'
       db      cr,lf,lf,'$'
       endif

       DB      'Copyright (C) 1980, 1981 CompuServe Incorporated',CR,LF
       DB      CR,LF,'$'

START0: LXI     SP,STACK                ; SET UP OUR OWN STACK
       MVI     C,FN$ID         ; GET CURRENT CP/M DISK DRIVE
       CALL    BDOS
       STA     CPMDEF
       LHLD    BBASE+1         ; GET START OF BIOS
       XCHG
       LXI     H,3             ; OFFSET TO CONSOLE CHECK
       DAD     D
       SHLD    TRMGET+1        ; STORE ADDRESS
       LXI     H,6             ; OFFSET TO CONSOLE READ
       DAD     D
       SHLD    TERMRD+1
       if      usebios
       LXI     H,9             ; OFFSET TO CONSOLE WRITE
       DAD     D
       SHLD    TERMWR+1
       endif
       LXI     H,2AH           ; OFFSET TO LIST STATUS
       DAD     D               ; MUST BE IMPLEMENTED IN BIOS
       SHLD    LSTST+1         ; FOR PRINT BUFFERING TO WORK

       XRA     A               ; DISABLE PRINTER OUTPUT
       STA     PRTFLG
       STA     SIFLAG          ; NO <SI> SEEN
       if      shoxfr
       sta     shoflg          ; Don't come up in "show transfer"
       endif                   ; mode!
       CALL    INISIO          ; INITIALIZE MODEM UART
       LXI     D,BANNER        ; ANNOUNCE OURSELVES
       MVI     C,FN$PCB
       CALL    BDOS

; TERMINAL EMULATOR LOOP

TERM:   CALL    TRMGET
       JZ      TSTSIN
       CPI     MON             ; IF USER WANTS TO RETURN TO CP/M

       IF      NOT PMMI
       JZ      BBASE           ; THEN DO IT!
       ENDIF   ;NOT PMMI

       IF      PMMI
       JZ      DISCON          ; DISCONNECT MODEM
       ENDIF   ;PMMI

       CPI     ENQ             ; IF ^E
       JZ      BBASE           ; THEN JUST EXIT
       CPI     DC2             ; IF ^R
       JZ      PRTON           ; THEN TURN PRINTER ON
       CPI     DC4             ; IF ^T
       JZ      PRTOFF          ; THEN TURN PRINTER OFF
       CALL    PUTSIO          ; ELSE PUT CHAR OUT TO SIO

TSTSIN: CALL    GETSIN          ; ELSE GET A CHAR FROM SIO
       JZ      TSTPRT
       CPI     DLE             ; IF <DLE>
       JZ      ISDLE           ; THEN PROCESS <DLE>
       CPI     SI              ; IF <SI>
       JZ      ISSI            ; THEN PROCESS <SI>
       CPI     SO              ; IF <SO>
       JZ      ISSO            ; THEN PROCESS <SO>
       CPI     ESC             ; IF <ESC>
       JZ      ISESC           ; THEN GO PROCESS ESCAPE SEQUENCE
       CPI     DC2             ; IF ^R
       JZ      PRTON           ; THEN TURN PRINTER ON
       CPI     DC4             ; ELSE IF ^T
       JZ      PRTOFF          ; THEN TURN PRINTER OFF

       IF      HZ19            ; IF RUNNING A H/Z-19 CONSOL
       CPI     FF              ; THEN IF CHAR IS <FF>
       JZ      FFHZ19          ; THEN MAP IT TO <ESC><E>
       ENDIF

NOTSIM: CALL    TERDSP          ; DISPLAY/PRINT CHARACTER
TSTPRT:
LSTST:  CALL    0000            ; MODIFIED TO LIST STATUS
       ORA     A
       JZ      TERM            ; IF PRINTER IS BUSY
                               ; THEN CONTINUE TO SERVICE THE
                               ; KEYBOARD & MODEM AT HIGH POLLING RATE
       LHLD    HEAD            ; GET HEAD POINTER
       XCHG
       LHLD    TAIL            ; AND TAIL POINTER
       CALL    DEHLCMP         ; SEE IF THEY ARE EQUAL
       JZ      TERM            ; IF SO, BUFFER IS EMPTY, SO EXIT
       PUSH    H               ; SAVE TAIL POINTER
       MOV     A,M             ; GET THE CHAR
       ANI     7FH             ; STRIP PARITY
       LXI     H,LINCNT        ; POINT TO LINE COUNTER
       CPI     FF              ; IF FF
       JZ      NEWPAGE         ; RESET LINE COUNTER
       CPI     LF              ; IF LF
       JNZ     OUTP            ; DECREMENT LINE COUNTER
       DCR     M               ; IF ROOM LEFT ON PAGE
       JNZ     OUTP            ; OUTPUT THE LF
NEWPAGE MVI     M,PAGLEN        ; ELSE A FF
       MVI     A,FF
OUTP:   MOV     E,A
       MVI     C,FN$WL         ; CHAR TO LIST DEVICE
       CALL    BDOS
       POP     H               ; RESTORE TAIL PTR
       INX     H
       LDA     BDOS+2          ; CHECK FOR MEMORY TOP
       DCR     A
       CMP     H
       JNC     OUTP1
       LXI     H,PRTBUF        ; WRAPAROUND
OUTP1:  SHLD    TAIL            ; UPDATE TAIL PTR
       JMP     TERM

DEHLCMP:        ; TEST (DE)-(HL) COMPARISON
       MOV     A,D
       CMP     H
       RNZ
       MOV     A,E
       CMP     L
       RET


; GET A CHARACTER FROM LOCAL TERMINAL
; RETURN Z FLAG IF LOCAL NOT READY

TRMGET: CALL    0000H           ; **** MODIFIED ADDRESS!!!
       ANI     01
       RZ                      ; RETURN IF NO LOCAL INPUT
TERMRD: CALL    0000H           ; **** MODIFIED ADDRESS!!!
       ANI     7FH             ; RETURN WITH PARITY STRIPPED
       RET

; HERE IF <DC2> (^R) RECEIVED FROM HOST OR CONSOLE

PRTON:  MVI     A,0FFH          ; SET PRINTER FLAG
       STA     PRTFLG
       JMP     TERM

; HERE IF <DC4> (^T) RECEIVED FROM HOST OR CONSOLE

PRTOFF: XRA     A               ; CLEAR PRINTER FLAG
       STA     PRTFLG
       JMP     TERM

; HERE IF <DLE> RECEIVED FROM HOST

ISDLE:  CALL    GETSIX          ; GET CHARACTER FOLLOWING <DLE>
       CALL    TERDSP          ; DISPLAY IT ON CONSOLE/PRINTER
       JMP     TERM

ISSO:   XRA     A       ; <SO> DISABLES PROTOCOL MODE
       if      shoxfr
       sta     shoflg
       endif
       LXI     SP,STACK        ; RESTORE STACK INCASE OF ABORT
ISSI:   STA     SIFLAG  ; <SI> ENABLES PROTOCOL MODE
       JMP     TERM

; HERE ON <ESC>

ISESC:  LDA     SIFLAG  ; IF <SI> NOT RECEIVED
       ORA     A
       MVI     A,ESC

       IF      NOT HZ19
       JZ      NOTSIM  ; THEN JUST DISPLAY IT
       ENDIF

       IF      HZ19
       JZ      CK1061          ; THEN CHECK FOR SPECIAL MAPPINGS
       ENDIF

ISESCN: CALL    GETSIX  ; ELSE GET CHARACTER FROLLOWING <ESC>
       CPI     'I'     ; IF <ESC><I>
       JNZ     ESC0    ; THEN
       LXI     H,SYSID         ; SEND THE ID STRING TO HOST

SNDID:  MOV     A,M             ; GET NEXT ID BYTE
       ORA     A               ; IF NULL
       JZ      TERM            ; THEN FINISHED
       CALL    PUTSIO          ; ELSE SEND TO HOST
       INX     H
       JMP     SNDID


       IF      HZ19            ; IF WE HAVE A H/Z-19 AS CONSOLE
CK1061: CALL    GETSIX          ; GET CHAR FOLLOWING <ESC>
       CPI     'j'             ; <ESC><j> = <ESC><E>
       JNZ     NT1061
FFHZ19: MVI     A,'E'
NT1061: PUSH    PSW
       MVI     A,ESC
       CALL    TERDSP
       POP     PSW
       JMP     NOTSIM
       ENDIF                   ; H/Z-19 MAPPING

ESC0:   CPI     'L'     ; IF <ESC><L>
       JNZ     ESC1    ; THEN
       MVI     E,0     ;       PERFORM SYSTEM LOAD FUNCTION
       CALL    GETCKS  ; GET BYTE COUNT
       MOV     B,A
       CALL    GETCKS  ; GET LOW ADDRESS BYTE
       MOV     L,A
       CALL    GETCKS
       MOV     H,A     ; AND HIGH-ORDER

ESCL0:  CALL    GETCKS  ; GET NEXT DATA BYTE
       MOV     M,A     ; SAVE IT
       INX     H       ; BUMP MEMORY ADDRESS
       DCR     B       ; COUNT BYTES RECEIVED
       JNZ     ESCL0   ; & LOOOP TILL ZERO
       MOV     C,E     ; SAVE CHECKSUM
       CALL    GETCKS  ; GET NEXT BYTE
       CMP     C       ; IF MATCH
       MVI     A,'.'   ; THEN SEND .
       JZ      ESCL1   ; ELSE
       MVI     A,'/'   ;       SEND /
ESCL1:  CALL    PUTSIO
       if      not shoxfr
       call    viomrk          ; display protocol mark
       endif
       JMP     TERM

       if      not shoxfr
viomrk:
       push    psw
       mvi     a,cr
       call    viodsp
       mvi     a,lf
       call    viodsp
       mvi     a,32
       sta     xfrctr
       pop     psw
       cpi     '.'
       cnz     viodsp
       ret

ctxfr:  push    h
       push    psw
       lxi     h,xfrctr        ; decrement count of xfr'd characters
       dcr     m
       jnz     ctxfr0
       mvi     m,32
       mvi     a,'+'           ; display '+' every 32 bytes
       call    viodsp
ctxfr0: pop     psw
       pop     h
       ret
       endif


ESC1:   CPI     'A'     ; IF <ESC><A>
       JNZ     TERM    ; THEN

; Initialize for data transmission using the CompuServe A-protocol
; The protocol begins with the following being sent from the host:
;       <ESC><A><SOH><U | D><A | B><FILESPEC><ETX><CKSUM>
; where:
;       U = upload, D = download
;       A = ASCII (file ends in 1Ah), B = binary
;       FILESPEC = standard CP/M file specification, including optional drive
;       CKSUM = checksum for the record

       MVI     A,'0'           ; INIT RECORD NUMBER
       STA     APNXT
       CALL    APRCVX          ; GET COMMAND LINE FROM HOST
       LXI     H,APBUF+2       ; POINT TO FILE SPEC FROM USER
       LXI     D,TFCB          ; POINT TO FILE CONTROL BLOCK
       MOV     B,M             ; GET POSSIBLE DISK DRIVE NAME
       INX     H               ; IF : NEXT
       MOV     A,M
       CPI     ':'
       JNZ     NOCOL           ; THEN
       INX     H               ; SKIP THE COLON
       MVI     A,7             ; MASK OFF DRIVE NUMBER
       ANA     B
       JMP     FIRSTB

NOCOL:  DCX     H               ; POINT BACK TO FIRST FILE BYTE
       XRA     A               ; USE DEFAULT DRIVE NUMBER
FIRSTB: STAX    D               ; STORE DRIVE NUMBER
       INX     D               ; POINT TO FIRST FILE NAME BYTE
       MVI     B,8             ; MAX LENGTH OF NAME
       CALL    NAAME           ; GET FILE NAME
       MOV     A,M             ; GET NEXT BYTE
       CPI     '.'             ; IF . PRESENT
       JNZ     EXT             ; THEN
       INX     H               ; SKIP OVER IT
EXT:    MVI     B,3             ; LENGTH OF EXTENSION
       CALL    NAAME           ; GET EXTENSION
       XRA     A               ; ZERO FILE EXTENT
       STAX    D
       LDA     TFCB            ; SELECT THE DISK
       ORA     A               ; IF 0 THEN USE DEFAULT DISK
       JZ      NODISK
       SUI     1               ; MAP A INTO 0, B INTO 1, ETC.
       MOV     E,A
       MVI     D,0
       MVI     C,FN$SD
       CALL    BDOS

NODISK:
       lda     apbuf+1         ; store transfer type
       sta     xfrtyp
       LDA     APBUF           ; CHECK DIRECTION
       CPI     'D'             ; IF DOWN LOAD
       JNZ     CHKUPL          ; THEN
       lxi     d,dnload
       mvi     c,fn$pcb
       call    bdos
       MVI     C,FN$OPN        ; IF THE FILE EXISTS
       CALL    DSKOP
       CPI     0FFH
       JZ      DLOKAY          ; THEN
       LXI     D,DLBOMB        ;       TELL THE USER ABOUT IT
       MVI     C,FN$PCB
       CALL    BDOS
       MVI     C,FN$RC         ; GET USER'S RESPONSE
       CALL    BDOS
       ani     7fh
       PUSH    PSW
       MVI     A,CR
       CALL    VIODSP
       MVI     A,LF
       CALL    VIODSP
       POP     PSW
       CPI     'Y'             ; IF NOT 'Y'
       JZ      DLDEL
       CPI     'y'
       JNZ     ABORT           ; THEN ABORT THE DOWNLOAD ATTEMPT
DLDEL:  MVI     C,FN$DEL        ; ELSE DELETE THE FILE
       CALL    DSKOP
DLOKAY: CALL    OPNOUT          ; OPEN FOR OUTPUT
       if      shoxfr
       mvi     a,0ffh
       sta     shoflg
       endif

; THE FOLLOWING LOOP DOES THE DOWNLOAD FUNCTION

DL0:    CALL    APRCV           ; GET NEXT LINE OF DATA
       JNZ     DLEOT           ; HANDLE END OF TRANSMISSION
       LXI     H,APBUF         ; POINT TO BUFFER
DL1:    MOV     A,M             ; GET NEXT BYTE
       INX     H               ; POINT TO NEXT BYTE
       CALL    PUTBYT          ; PUT IT INTO OUTPUT BUFFER
       DCR     B               ; COUNT THE BYTE
       JNZ     DL1
       JMP     DL0             ; GET NEXT RECORD FROM HOST

; HERE WHEN THE HOST'S <EOT> MESSAGE HAS BEEN RECEIVED

DLEOT:
       lda     xfrtyp          ; if binary transfer
       cpi     'B'
       jz      dleotb          ; then don't insert ^Z
       MVI     A,EOF           ; PUT ^Z (END OF FILE MARK)
       CALL    PUTBYT
dleotb: MVI     C,FN$WDR
       CALL    DSKOP
DLEOT0: MVI     C,FN$CLS
       CALL    DSKOP
       CALL    RSTDEF
       MVI     A,'.'           ; TELL HOST WE GOT IT
       CALL    PUTSIO
       if      not shoxfr
       call    viomrk
       endif
       if      shoxfr
       xra     a
       sta     shoflg
       endif
       JMP     TERM            ; BACK TO TERMINAL MODE

; HERE IF NOT A DOWN LOAD - BETTER BE UP LOAD!

CHKUPL: CPI     'U'
       JNZ     ABORT           ; SEND NAK TO HOST IF NOT .
       lxi     d,upload
       mvi     c,fn$pcb
       call    bdos
       CALL    OPNINP          ; OPEN THE FILE FOR INPUT
       MVI     A,'.'           ; TELL HOST WE'RE READY TO SEND DATA
       CALL    PUTSIO
       if      not shoxfr
       call    viomrk
       endif

; THE UPLOAD FUNCTION IS DONE IN THE FOLLOWING LOOP:

       CALL GETSIX             ; GET HOST'S PROMPT
       CPI     '.'             ; ABORT IF NOT '.'
       JNZ     ABORT
       if      shoxfr
       mvi     a,0ffh
       sta     shoflg
       endif

UPL1:   MVI     B,0             ; INIT COUNT
       LXI     H,APBUF
UPL2:   CALL    GETBYT          ; GET DATA FROM FILE
       jp      upl3            ; jump if <EOF> occured
       MOV     M,A             ; THEN PUT INTO BUFFER
       INX     H               ; BUMP POINTER
       INR     B               ; AND BYTE COUNT
       JNZ     UPL2            ; GET NEXT BYTE IF BUFFER NOT FILLED
UPL4:   MOV     A,B             ; SAVE COUNT
       STA     APLEN
       CALL    APSND           ; SEND THE DATA
       JMP     UPL1            ; GO DO NEXT LINE

UPL3:   MOV     A,B             ; WRITE FINAL DATA BLOCK IF THERE IS ONE
       STA     APLEN
       ORA     A
       CNZ     APSND
       MVI     A,0FFH          ; SEND <EOT> MESSAGE WITHOUT MASKING
       LXI     H,EOTMSG
       CALL    APSND0
       CALL    RSTDEF          ; RESTORE CP/M'S DEFAULT DISK DRIVE
       if      shoxfr
       xra     a
       sta     shoflg
       endif
       JMP     TERM            ; RETURN TO TERMINAL MODE

EOTMSG: DB      1,EOT

;***

; ROUTINE TO INTERFACE TO CP/M'S CONSOLE OUTPUT DRIVER

viodsp: push    b       ; save register
       push    d
       push    h
       push    psw
       if      usebios
       mov     c,a
TERMWR: CALL    0000H   ; ***** MODIFIED TO CONOT IN BIOS
       endif
       if      not usebios
       mov     e,a             ; call BDOS to write char on console
       mvi     c,fn$wc
       call    bdos
       endif
       pop     psw
       pop     h
       pop     d
       pop     b
       RET

; ROUTINE TO DISPLAY C(A) ON CP/M CONSOLE AND PRINTER IF NECESSARY

TERDSP: PUSH    PSW             ; SAVE C(A)
       CALL    VIODSP          ; DISPLAY ON CONSOLE
       POP     PSW             ; GET CHARACTER BACK
       MOV     E,A             ; SAVE CHARACTER
       LDA     PRTFLG          ; IF ^R RECEIVED
       ORA     A
       RZ                      ; THEN
; STORE THE CHAR IN THE PRINTER BUFFER
       LHLD    HEAD            ; GET BUFFER PTR
       MOV     M,E             ; STORE THE CHAR
       INX     H               ; BUMP PTR
       LDA     BDOS+2          ; CHECK FOR TOP OF MEMORY
       DCR     A
       CMP     H
       JNZ     TERDS1          ; IF REACHED, WRAPAROUND
       LXI     H,PRTBUF
TERDS1: SHLD    HEAD            ; UPDATE PTR
       RET

; ROUTINE TO OPEN A FILE FOR OUTPUT

OPNOUT: MVI     C,FN$CRE        ; CREATE FILE
       CALL    DSKOP   ; CALL CP/M
       CPI     0FFH    ; IF OKAY
       JZ      ERRCRE          ; ERROR DURING CREATE (DIRECTOR FULL?)
       XRA     A       ; CLEAR NEXT RECORD COUNT
       STA     TFCB+FCB$NR
       STA     IBP     ; INIT BUFFER POINTER
       RET

; ROUTINE TO OPEN FILE FOR INPUT

OPNINP: MVI     C,FN$OPN
       CALL    DSKOP
       CPI     0FFH            ; IF FI
LE NOT FOUND
       JZ      ERROPN          ; THEN ERROR MESSAGE TIME!
       XRA     A
       STA     TFCB+FCB$NR     ; INIT TO FIRST RECORD
       MVI     A,80H           ; "EMPTY BUFFER"
       STA     IBP
       RET


; ROUTINE TO PUT C(A) INTO DISK BUFFER

PUTBYT: PUSH    B       ; SAVE REGS
       PUSH    D
       PUSH    H
       PUSH    PSW     ; SAVE BYTE
       LDA     IBP     ; IF BUFFER IS FULL
       CPI     80H
       JNZ     PUT0    ; THEN
       MVI     C,FN$WDR
       CALL    DSKOP
       ORA     A
       JNZ     ERRWDR          ; WRITE ERROR???
       XRA     A       ; INIT IBP TO 0

PUT0:   MOV     E,A     ; SAVE CUR BYTE POSITION
       MVI     D,0
       INR     A       ; BUMP POINTER
       STA     IBP
       LXI     H,TBUFF ; POINT TO BUFFER
       DAD     D       ; NOW POINT TO BYTE
       POP     PSW     ; GET BYTE
       MOV     M,A     ; STORE BYTE
       POP     H       ; RESTORE REGS
       POP     D
       POP     B
       RET

; ROUTINE TO GET NEXT BYTE FROM A DISK RECORD

GETBYT: PUSH    B       ; SAVE REGS
       PUSH    D
       PUSH    H
       mvi     b,0     ; assume not <EOF>
       LDA     IBP     ; IF BUFFER IS EMPTY
       CPI     80H
       JNZ     GET0
       MVI     C,FN$RDR
       CALL    DSKOP
       mov     b,a             ; save return code (0 implies okay)
       XRA     A       ; RESET BYTE POINTER
GET0:   MOV     E,A     ; SAVE BYTE POS
       MVI     D,0
       INR     A       ; BUMP BYTE POS
       STA     IBP
       LXI     H,TBUFF
       DAD     D
       lda     xfrtyp          ; if binary transfer
       cpi     'B'
       jz      gtbtbn          ; then don't check for ^Z
       MOV     A,M     ; GET THE BYTE
       cpi     eof     ; if ^Z
       jnz     gtrstr  ; then
       mvi     b,1     ; we will exit with N cleared
gtrstr: dcr     b       ; set N if NOT eof
       POP     H       ; RESTORE REGS
       POP     D
       POP     B
       RET

gtbtbn: mov     a,m     ; get binary byte
       jmp     gtrstr  ; set N flag and exit

; FATAL CP/M ERROR CONDITIONS PRINT A LOCAL MESSAGE
; THEN SEND A <NAK> TO HOST

ERRCRE: LXI     D,CREMSG
       JMP     DFATAL


ERROPN: LXI     D,OPNMSG
       JMP     DFATAL


ERRWDR: LXI     D,WDRMSG
       JMP     DFATAL



DFATAL:
FATAL:  MVI     C,FN$PCB                ; WRITE ERROR MESSAGE
       CALL    BDOS

ABORT:
       lxi     d,abload        ; tell user we are aborting
       mvi     c,fn$pcb
       call    bdos
       MVI     C,FN$CLS
       CALL    DSKOP
       CALL    RSTDEF          ; RESTORE DEFAULD DISK
       MVI     A,KNAK
       CALL    PUTSIO                  ; TELL HOST WE HAVE BOMBED
       JMP     ISSO                    ; DISABLE PROTOCOL MODE

; HERE TO DO A CP/M DISK OPERATION; CALLED WITH DESIRED FUNCTION CODE IN C

DSKOP:  LXI     D,TFCB
       CALL    BDOS
       PUSH    PSW             ; SAVE RETURN CODE
       XRA     A               ; OUTPUT A NULL TO CONSOLE
       CALL    VIODSP          ; TO FLUSH DISK BUFFER
       POP     PSW             ; RESTORE DSK RETURN CODE
       RET

; ROUTINE TO RESTORE CP/M'S DEFAULT DISK DRIVE

RSTDEF: LDA     CPMDEF
       MOV     E,A
       MVI     D,0
       MVI     C,FN$SD
       CALL    BDOS
       RET

; ROUTINE TO EXTRACT FILE NAME AND EXTENSION

NAAME:  MOV     A,M     ; GET NEXT BYTE
       CPI     CR      ; <RET> ENDS NAME
       JZ      FILL    ; FILL IF END OF STRING
       CPI     '.'     ; IF EXTENSION
       JZ      FILL    ; THEN FILL OUT WITH SPACES
       INX     H       ; SKIP THIS BYTE
       CPI     60H     ; LOWER CASE A
       JC      NAME1   ; JUMP IF NOT LOWER CASE
       SBI     20H     ; CONVERT LOWER CASE TO UPPER
NAME1:  STAX    D       ; STORE BYTE IN FCB
       INX     D
       DCR     B       ; COUNT THIS BYTE
       JNZ     NAAME   ; PROCESS NEXT IF MORET
       RET

FILL:   MVI     A,' '   ; STORE A SPACE
       JMP     NAME1


; THIS ROUTINE RECEIVES A RECORD USING THE ASCII PROTOCOL

APRCV:  MVI     A,'.'   ; PROMPT REMOTE FOR NEXT RECORD
       CALL    PUTSIO
       if      not shoxfr
       call    viomrk
       endif
APRCVX: LDA     APNXT   ; BUMP EXPECTED RECORD NUMBER
       INR     A
       CPI     '9'+1   ; WRAP-AROUND
       JC      APRCVY  ; JUMP IF LEQ 9
       MVI     A,'0'
APRCVY: STA     APNXT
       if      not shoxfr
       call    viodsp
       endif
APRCV0: CALL    TRMGET          ; GET LOCAL KEYBOARD INPUT
       CPI     ETX                     ; IF ^C
       JZ      ABORT                   ; THEN ABORT THE TRANSFER
       CALL    GETSIX  ; GET NEXT CHARACTER
       CPI     SOH     ; <SOH> STARTS THE RECORD
       JZ      APRCV1
       CPI     ETX     ; <ETX> BY ITSELF IS QUESTIONABLE
       JNZ     APRCV0
       MVI     A,'/'   ; SEND A LOGICAL NAK
       CALL    PUTSIO
       if      not shoxfr
       CALL    VIODSP
       endif
       JMP     APRCV0

APRCV1: MVI     E,0     ; INIT CHECKSUM
       MOV     B,E     ; INIT BYTE COUNT
       MOV     A,E     ; CLEAR <EOT> FLAG
       STA     APEOT
       LXI     H,APBUF
       CALL    GETCKS  ; GET SENDER'S RECORD NUMBER
       STA     APCUR

APRCV2: CALL    GETCKS  ; GET A CHECKSUMMED CHARACTER
       JZ      APRCV3
       MOV     M,A     ; PUT BYTE IN BUFFER
       INR     B       ; COUNT THIS BYTE
       INX     H
       if      not shoxfr
       call    ctxfr   ; display '+' every 32 bytes
       endif
       JMP     APRCV2

APRCV3: MOV     C,E     ; SAVE CHECKSUM
       CALL    GETCKS  ; GET REMOTE'S CHECKSUM
       CMP     C       ; IF SAME
       JNZ     APRCV4  ; THEN
       LDA     APNXT           ; CHECK RECORD COUNT
       MOV     C,A
       LDA     APCUR
       CMP     C
       JNZ     APRCV8          ; JUMP IF NOT MATCHED
       MOV     A,B     ; STORE BYTE COUNT
       STA     APLEN
       LDA     APEOT   ; RETURN WITH EOT FLAG STATUS
       ORA     A
       RET

APRCV4: MVI     A,'/'   ; ELSE REQUEST RETRANSMISSION
       CALL    PUTSIO
       if      not shoxfr
       CALL    VIODSP
       endif
       JMP     APRCV0

APRCV8: JNC     ABORT           ; ABORT IF RCV GTR EXPECTED
       MVI     A,'.'           ; MUST HAVE RECEIVED A DUPLICATE RECORD
       CALL    PUTSIO          ; ACCEPT IT, AND TRY AGAIN
       if      not shoxfr
       call    viomrk
       endif
       JMP     APRCV0


; ROUTINE TO SEND A MESSAGE

APSND:  XRA     A               ; Flag for masking control characters
       LXI     H,APLEN         ; BUFFER ADDRESS: LENGTH FOLLOWED BY DTA
APSND0: STA     APFLG           ; STORE MASK FLAG
       SHLD    APADDR          ; STORE BUFFER ADDRESS
       LDA     APNXT           ; BUMP NEXT RECORD COUNT
       INR     A
       CPI     '9'+1
       JC      ASND0A
       MVI     A,'0'
ASND0A: STA     APNXT
       if      not shoxfr
       call    viodsp
       endif

APSND1: MVI     E,0             ; CLEAR CHECKSUM
       LHLD    APADDR
       MOV     B,M             ; GET LENGTH
       INX     H               ; POINT TO DATA
       MVI     A,SOH           ; START THE MESSAGE
       CALL    APPUTS
       LDA     APNXT           ; SEND RECORD NUMBER
       CALL    DOCKS           ; UPDATE CHECKSUM
       CALL    APPUTS
APSND2: MOV     A,M             ; GET NEXT DATA BYTE
       CALL    DOCKS           ;UPDATE CHECKSUM
       CPI     20H             ; IF CONTROL CHARACTER
       JNC     ASND2A          ; THEN
       LDA     APFLG           ; IF MASKING CONTROL CHARACTERS
       ORA     A
       MOV     A,M             ; GET BYTE AGAIN
       JNZ     ASND2A          ; THEN
       CPI     05H             ; FOR EFFICIENCY, ONLY MASK THE BADDIES
       JC      ASND2B          ; MASK 00H 01H 02H 03H 04H
                               ;      NUL SOH STX ETX EOT
       CPI     dle
       JZ      ASND2B          ; 10H DLE
       CPI     knak
       JNZ     ASND2A          ; 15H NAK
ASND2B: MVI     A,DLE           ; SEND <DLE><DATA+40H)
       CALL    APPUTS
       MOV     A,M
       ORI     40H
ASND2A: CALL    APPUTS          ; TRANSMIT THE CHARACTER
       INX     H
       if      not shoxfr
       call    ctxfr           ; display '+' every 32 characters
       endif
       DCR     B
       JNZ     APSND2  ; BACK FOR MORE IF ANY

APSND3: MVI     A,ETX           ; TERMINATE THE TEXT PORTION
       CALL    APPUTS
       MOV     A,E             ; GET CHECKSUM
       CPI     20H             ; IF < 20H
       JNC     ASND3A          ; THEN
       MVI     A,DLE           ; SEND IT MASKED
       CALL    APPUTS
       MOV     A,E
       ORI     40H
ASND3A: CALL    APPUTS

ASND4A: MVI     C,30            ; ABOUT 4 SECONDS
ASND4C: LXI     D,2500H         ;
ASND4:  CALL    GETSIN          ; GET HOST'S REPLY
       JNZ     SND4B
       CALL    TRMGET
       CPI     ETX
       JZ      ABORT           ; ABORT THE OPERATION IF ^C TYPED
       DCX     D               ; DECREMENT INNER LOOP COUNT
       MOV     A,D
       ORA     E
       JNZ     ASND4
       DCR     C
       JNZ     ASND4C
       MVI     A,ETX           ; SEND EXTRA <ETX>
       CALL    APPUTS
       JMP     ASND4A

snd4b:
       if      shoxfr
       call    viodsp
       endif
       if      not shoxfr
       call    viomrk
       endif
       CPI     '.'
       RZ                      ; RETURN IF HOST GOT IT OKAY
       CPI     '/'             ; ELSE IF /
       JZ      APSND1          ; THEN RETRANSMIT THE MESSAGE
       CPI     KNAK            ; ELSE IF <NAK>
       JZ      ISSO            ; THEN ABORT
       JMP     ASND4           ; ELSE KEEP WAITING

APPUTS: PUSH    PSW             ; SAVE CHAR
       CALL    GETSIN          ; CHECK MODEM FIRST
       JZ      APPUT4          ; THEN
       ani     7fh
       CPI     KNAK            ; IF WE RECEIVE A <NAK>
       JZ      ISSO            ; THEN SHUT DOWN THE PROTOCOL
       CPI     DC3             ; IF X-OFF
       JNZ     APPUT4          ; THEN
       PUSH    D               ; DELAY A FEW SECONDS
       PUSH    B
       MVI     B,2
APPUT0: LXI     D,8000H
APPUT1: CALL    GETSIN          ; IF CHAR PRESENT
       JZ      APPUT2          ; THEN
       ani     7fh
       CPI     DC1             ; IF ^Q (XON)
       JZ      APPUT3          ; THEN EXIT
APPUT2: DCX     D
       MOV     A,D
       ORA     E
       JNZ     APPUT1
       DCR     B
       JNZ     APPUT0
APPUT3: POP     B               ; RESTORE REGS AND RETURN
       POP     D
APPUT4: POP     PSW             ; GET CHAR
       CALL    PUTSIO          ; SEND CHAR
       RET


; ROUTINE TO GET A CHARACTER FROM UART WITH WAIT

GETSIN: CALL    GETSIO  ; RETURN SIO CHAR WITH BIT 7 = 0
       RZ
       ANI     7FH
       RET

GETSIX: CALL    GETSIO  ; GET SIO CHAR OR WAIT
       JZ      GETSIX  ; WAIT FOR A CHARACTER
       CPI     KNAK    ; IF <NAK> RECEIVED
       JZ      ISSO    ; THEN REVERT TO TERMINAL MODE
       RET             ; RETURN


GETCKS: CALL    GETSIX  ; GET NEXT SIO CHAR WITH CHECKSUMMING
       CPI     ETX     ; IF <ETX>
       RZ              ; THEN RETURN
       PUSH    PSW
       CPI     EOT
       JNZ     NOTEOT  ; THEN
       STA     APEOT   ; SET <EOT> SEEN FLAG
NOTEOT: CPI     DLE     ; IF <DLE>
       JNZ     GETCK0  ; THEN
       CALL    GETSIX  ;       GET NEXT CHARACTER
       ANI     1FH     ;       MAKE CONTROL CHAR OF IT
GETCK0: CALL    DOCKS   ; UPDATE CHECKSUM
       POP     PSW     ; RESTORE FLAGS
       MOV     A,D     ; RESTORE NEW CHAR
       RET             ; RETURN

DOCKS:  MOV     D,A     ; SAVE BYTE
       MOV     A,E     ; GET OLD CHECKSUM
       RLC             ; ROTATE ONE BIT LEFT
       ADD     D       ; ADD NEW BYTE
       ACI     0       ; ADD POSSIBLE CARRY
       MOV     E,A     ; REPLACE CHECKSUM WITH UPDATED ONE
       MOV     A,D     ; RESTORE NEW BYTE
       RET

;       VARIOUS MESSAGE STRINGS

proini: db      cr,lf,'% CSEXEC - Initializing file transfer',cr,lf,'$'
dnload: db      cr,lf,'% CSEXEC - Beginning Download',cr,lf,'$'
upload: db      cr,lf,'% CSEXEC - Beginning Upload',cr,lf,'$'
abload: db      cr,lf,'? CSEXEC - Aborting file transfer',cr,lf,'$'
DLBOMB: DB CR,LF,'% CSEXEC - That file already exists on your disk.',CR,LF
       DB      'Do you wish to replace it (Y or N) ? $'
CREMSG: DB      cr,lf,'? CSEXEC - Diskette is full!',CR,LF,'$'
opnmsg: db Cr,lf,'? CSEXEC - That file is not on your diskette!',cr,lf,'$'
wdrmsg: db      cr,lf,'? CSEXEC - Your diskette is full!',cr,lf,'$'
dmsg:   db      cr,lf,'++DISCONNECTED++',cr,lf,'$'

; I/O SUBROUTINES FOR SIO

SIOGET: IN      CTL     ; GET MIO STATUS FLAGS
       ANI     SIOIR   ; ISOLATE INPUT READY FLAG
       if      not hitrue
       XRI     SIOIR   ; INVERT IT
       endif
       RZ              ; RETURN IF NOW 0
       IN      SIO     ; ELSE GET SIO CHARACTER

       if      shoxfr
       call    prodsp
       endif
       RET             ; AND RETURN (Z FLAG = 0)

SIOPUT: PUSH    PSW     ; WRITE (A) TO SIO
PUTSI1: IN      CTL     ; WAIT FOR FLAG TO = 0
       ANI     SIOTR
       if      not hitrue
       JNZ     PUTSI1
       endif

       if      hitrue
       jz      putsi1
       endif
       POP     PSW
       OUT     SIO

       if      shoxfr
       if      hz19
       push    psw
       mvi     a,esc   ; invert video for incoming characters
       call    viodsp
       mvi     a,'p'
       call    viodsp
       pop     psw
       push    psw
       call    prodsp
       mvi     a,esc
       call    viodsp
       mvi     a,'q'           ; return to normal video
       call    viodsp
       pop     psw
       endif

       if      not hz19
       call    prodsp
       endif

       endif
       RET

sioini:
       if      hz89
       mvi     a,3             ; init uart to
       out     sio+3           ; 8 data bits, 1 stop bit, no parity
       endif

       if      pmmi
       mvi     a,93            ; 8 data bits, 1 stop bit, no parity
       out     basprt
       mvi     a,52            ; 300 baud
       out     basprt+2
       mvi     a,127           ; originate mode
       out     basprt+3
       endif

       ret

       if      shoxfr
prodsp: push    psw             ; save the character
       lda     shoflg          ; if in protocol
       ora     a
       jz      proter          ; then
       pop     psw
       push    psw
       ani     7fh             ; remove high-order bit
       cpi     ' '             ; if this is a control char
       jnc     proyes          ; then
       lda     xfrtyp          ; if doing a binary transfer
       cpi     'B'
       jz      pronot          ; then "flag" all control characters
       pop     psw             ; else flag only funny ones
       push    psw
       cpi     sholcc          ; is it a normal control character?
       jc      pronot          ; (ie, <HT> thru <RET>, 08h - 0Dh)
       cpi     shohcc+1
       jc      proyes
pronot: mvi     a,'^'           ; flag the control character
       call    viodsp
       pop     psw
       push    psw
       adi     40h             ; map char to letter
proyes: call    viodsp
proter: pop     psw
       ret

       endif

       if      pmmi    ; routine to disconnect pmmi modem
discon: mvi     a,03fh
       out     basprt+3
       xra     a
       out     basprt
       out     basprt+2
       lxi     d,dmsg  ; print disconnect msg
       mvi     c,fn$pcb
       call    bdos
       jmp     bbase   ; and exit
       endif

;       RAM STORAGE AREA

       if      shoxfr
shoflg: ds      1               ; 1 if in file transfer protocol
       endif
       if      not shoxfr
xfrctr: ds      1               ; counter for displaying +'s
       endif
CPMSTK: ds      2               ; SAVES CP/M'S STACK POINTER
CPMDEF: ds      1               ; SAVES CP/M'S DEFAULT DISK DRIVE
PRTFLG: ds      1       ; FF IF PRINTER ENABLED, 00 OTHERWISE
SIFLAG: ds      1       ; NON-ZERO IMPLIES <SI> RECEIVED AND PROTOCOL ACTIVE
APEOT:  ds      1       ; NON ZERO IF <EOT> SEEN IN GETCKS
APFLG:  ds      1       ; 00 IF MASKING CONTROL CHARACTERS, FF IF NOT
xfrtyp: ds      1       ; 'A' if ASCII, 'B' if binary
APADDR: ds      2       ; POINTER TO BUFFER
APLEN:  DB      0       ; LENGTH OF RECORD AS RECEIVED
APBUF:  DS      256     ; STORAGE FOR THE RECORD
IBP:    DS      1       ; BYTE POINTER
APNXT:  DS      1       ; EXPECTED RECORD NUMBER
APCUR:  DS      1       ; CURRENT (RECEIVED) RECORD NUMBER
       DS      256     ; STACK GOES HERE
STACK:
HEAD:   DW      PRTBUF
TAIL:   DW      PRTBUF
LINCNT: DB      PAGLEN
PRTBUF  EQU     $

       END     START


You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.