MODULE ; XMODEM file transfer
;  2/18/86
    
; check out disk I/O, text and binary
;   what is convention for last byte when length is multiple of 256
; figure out monitoring of keyboard etc. before/during xfer.
; sort out declarations
;   decide on globals
;     compile must be case sensitive if use LF here (ACSTERM has lf)
;SET $4CA=$FF; --will this provoke symbol overflow?

PROC PBlock(BYTE ARRAY block, CARD size)
  CARD j
  BYTE DSPFLG=$2FE
  DSPFLG=1 ;write control char to screen (except EOL)
  FOR j=0 TO size-1 DO
    Put(block(j)) ;   block(j)=0
  OD
  DSPFLG=0
  PutE()
RETURN

MODULE; BLKIO------------------------------
; Copyright (c) 1983, 1984, 1985 by Action Computer Services (ACS)

BYTE CIO_status

CHAR FUNC CIO=*(BYTE dev, CARD addr,
          size, BYTE cmd, aux1, aux2)
[$29$F$85$A0$86$A1$A$A$A$A$AA$A5$A5
$9D$342$A5$A3$9D$348$A5$A4$9D$349
$A5$A6$F0$8$9D$34A$A5$A7$9D$34B$98
$9D$345$A5$A1$9D$344$20$E456
$8C CIO_status$C0$88$D0$6$98$A4$A0
$99 EOF$A085$60]

CARD FUNC ReadBlock=*(BYTE dev, CARD addr, size)
[$48$A9$7$85$A5$A9$0$85$A6$A5$A3$5$A4
$D0$6$85$A0$85$A1$68$60$68$20 CIO
$BD$348$85$A0$BD$349$85$A1$60]

PROC WriteBlock=*(BYTE dev, CARD addr, size)
; Writes size bytes from addr to dev.
; Status is saved in CIO_status.
[$48$A9$B$85$A5$A9$0$85$A6$A5$A3$5$A4
$D0$2$68$60$68$4C CIO]

MODULE ; part of BLOCKIO

; These will be from ACSTERM:
DEFINE modem = "5"
DEFINE file  = "3"
DEFINE STRING = "CHAR ARRAY"
DEFINE ASCII = "$0"
DEFINE EOL = "$9B"

CARD ARRAY end(0)
BYTE ARRAY fbuf
BYTE baud=[14], fmode
STRING Rdev(0)="R:"

BYTE FUNC MStatus=*()
  BYTE QLi=$2EB; DVSTAT+1, input queue length  
  XIO(modem,0,$D,0,0,Rdev)
RETURN (QLi)

PROC OpenModem(BYTE trans)
  Close(modem)
  Open(modem,Rdev,13,0)
  XIO(modem,0,36,baud,0,Rdev)
  XIO(modem,0,38,trans,0,Rdev)
  XIO(modem,0,40,0,0,Rdev) ; concurrent
RETURN

PROC MyClose(BYTE chan)
  Close(modem)
  Close(chan)  ; more than this in ACSTERM?
RETURN
 
PROC OpenFile(STRING msg)
  BYTE ARRAY spec(30)
  Print(msg)
  InputMD(0,spec,30)
  MyClose(file)
  Open(file,spec,fmode,0)
RETURN

PROC GetKey()
  BYTE CH=$2FC, c
  IF CH<>255 THEN
    c=GetD(7)
    IF c=EOL THEN c=$D FI
    PutD(modem,c)
  FI
RETURN

MODULE ; ----------------------------

DEFINE FALSE = "0"
DEFINE EOT = "4"
DEFINE SOH = "1"
DEFINE ACK = "6"
DEFINE LF  = "$A"
DEFINE CR  = "$D"
DEFINE NAK = "$15"
DEFINE SUB = "$1A"
DEFINE TIMEOUT = "$FFFF"
DEFINE RETRYMAX = "10"
DEFINE ERRORMAX = "10"

BYTE j, CheckSum, SectNum, TotErr, Errors
BYTE transx=[0], xeof
CHAR ARRAY block(128)
INT  dbufp  ; # of data bytes in fbuf, index of next
CARD ibuf
CARD BLen=[2000]; length of buffer (must be >2*128?)

CARD FUNC Receive(BYTE wait)
  CARD CDTMV3=$21C ; system timer counts down to 0
  BYTE CONSOL=$D01F
  CDTMV3 = 60*wait
  DO
    GetKey()
    IF MStatus() THEN 
      RETURN (GetD(modem)) 
    FI
    IF CONSOL!7 THEN CDTMV3 = 60 FI ; force timer to 1 sec.
  UNTIL CDTMV3=0 OD
RETURN (TIMEOUT)

PROC Send(CHAR c)
  PutD(modem,c)
RETURN

PROC PurgeLine(BYTE wait)
  DO UNTIL Receive(wait)=TIMEOUT OD
RETURN

; -----------------------------------
PROC WBuf() ; 128 bytes from block to disk buffer
; Must set dbufp=xeof=0 before 1st call.
; Caller must open and close file.
; Can't write out a block until next call, because don't know
; a block is last until EOT is received instead of next block.
  CARD j, len
  IF xeof THEN    ; preceeding block was final.
;print("EOF")
    IF transx=ASCII THEN
      FOR j=dbufp-128 TO dbufp-1 DO
        IF fbuf(j)=SUB THEN EXIT FI
      OD
      dbufp = j
    ELSE
      dbufp ==- (128-fbuf(dbufp-1))
    FI
  ELSE
;print("not EOF")
    FOR j=0 TO 127 DO
      fbuf(dbufp) = block(j)
      dbufp ==+ 1
    OD
  FI
;PBlock(block,dbufp)
;printf("dbufp=%U%E",dbufp)
  IF dbufp>BLen-128 OR xeof<>0 THEN ; flush buffer to disk
    IF transx=ASCII THEN
      ;replace CR-LF by EOL
      ;Don't touch a trailing CR, as LF might be in next block.
      ibuf = 0
      FOR j=0 TO dbufp-1 DO
        IF j<=dbufp-2 THEN
          IF (fbuf(j)&$7F)=CR AND fbuf(j+1)=LF THEN
            j ==+ 1
            fbuf(j) = EOL
          FI
        FI
        fbuf(ibuf) = fbuf(j)
        ibuf ==+ 1
      OD
      dbufp = ibuf  
    FI
    Close(modem)
    IF xeof THEN len = dbufp ELSE len = dbufp-128 FI
    WriteBlock(file,fbuf,len)
    OpenModem(32)
    ;Move remaining dbufp-len bytes to front of fbuf
    FOR j=len TO dbufp-1 DO
      fbuf(j-len) = fbuf(j)
    OD
    dbufp ==- len
  FI
RETURN ; WBuf

PROC RecFile()
  CARD ch, FirstChar
  BYTE SectCurr, ErrorFlag
  BYTE CONSOL=$D01F

  fmode = 8
  OpenFile("XMODEM download to file: ")
  dbufp = 0 : xeof = 0
  OpenModem(32)

  SectNum = 0
  Errors = 0  ; on current sector
  TotErr = 0  ; on file

  PurgeLine(0)
  Send(NAK)

  DO
    ErrorFlag = FALSE
    DO
      FirstChar = Receive(10)
      IF SectNum=0 OR (CONSOL&2)=0 THEN
        Put(FirstChar) ;** debug -FOX can type to screen
      FI
    UNTIL FirstChar=SOH OR FirstChar=EOT OR FirstChar=TIMEOUT OD
    IF FirstChar=TIMEOUT THEN
      ErrorFlag = 'T
;   ELSEIF FirstChar=EOT THEN
;     EXIT
    ELSEIF FirstChar=SOH THEN
      SectCurr = Receive(1)
      IF (SectCurr + Receive(1))=$FF THEN ; good sector number
        IF SectCurr=(SectNum+1) THEN
          CheckSum = 0
          FOR j=0 TO 127 DO
            ch = Receive(1)
            IF ch=TIMEOUT THEN
              ErrorFlag = 'T
              EXIT
            FI
            block(j) = ch
            CheckSum = CheckSum+ch
          OD
          IF CheckSum=Receive(1) THEN
            SectNum = SectCurr
            PrintF("Rec'd %U after %U tries%E%C",SectNum,Errors,$1C)
            Errors = 0
            WBuf()
            Send(ACK)
          ELSE ; bad checksum  ***or timeout in block
            ErrorFlag = 'C
          FI
        ELSEIF SectCurr=SectNum THEN ; already received this
          PurgeLine(1)
          Send(ACK)
        ELSE ; lost a sector
          ErrorFlag = 'S
        FI
      ELSE ; bad header
        ErrorFlag = 'H
      FI
    FI
    IF ErrorFlag THEN
      Errors ==+ 1
      IF SectNum THEN TotErr ==+ 1 FI
      PurgeLine(1)
      PrintF("Awaiting %U (try=%U, Errs=%U, type %C)%E",
        SectNum,Errors,TotErr,ErrorFlag)
      Send(NAK)
    FI      
  UNTIL FirstChar=EOT OR Errors=ERRORMAX OD
  IF FirstChar=EOT AND Errors<ERRORMAX THEN
    Send(ACK)
    xeof=1
    WBuf()  ; write buffer, close file
    PrintF("%EDone")
  ELSE
    PrintF("%EAborting")
  FI
  MyClose(file)
RETURN ; RecFile

; -----------------------------------

BYTE FUNC RBuf() ; read 128 bytes into block.
  BYTE i
  ; N.B.! set ibuf=dbufp=xeof=0 before 1st call
  IF xeof THEN RETURN(0) FI ; no more blocks
  i = 0
  WHILE i<128 DO
    IF ibuf=dbufp THEN ; no more data
      IF EOF(file) THEN ; already got EOF
        xeof = 1 ; flag for NEXT call to RBuf
        EXIT
      ELSE
        Close(modem)
        dbufp = ReadBlock(file,fbuf,BLen-1) ; could be zero
        ibuf = 0
        IF CIO_status=$88 THEN ; EOF
          CIO_status = 1 ; indicate OK
          IF transx=ASCII THEN
            fbuf(dbufp) = SUB ; CP/M & MSDOS EOF
            dbufp ==+ 1
          FI
        FI
        OpenModem(32)
;PrintF("read %U bytes,xeof=%U,EOF=%U%E%E",dbufp,xeof,EOF(file))
        IF dbufp=0 THEN EXIT FI
      FI
    FI
    IF fbuf(ibuf)=EOL AND transx=ASCII THEN
      block(i) = CR
      fbuf(ibuf) = LF  ; to send next
    ELSE
      block(i) = fbuf(ibuf)
      ibuf ==+ 1
    FI
    i ==+ 1 ; could make this a FOR loop??
  OD
  j = i
  WHILE i < 128 DO ; fill out last block with number of data bytes
    block(i) = j
    i ==+ 1
  OD
RETURN (1) ;RBuf

PROC SndFile()
  BYTE attempts=Errors, ch
  BYTE CONSOL=$D01F

  fmode = 4
  OpenFile("XMODEM upload of file: ")
  ibuf = 0 : dbufp = 0 : xeof=0
  OpenModem(32)

  PurgeLine(0)
  attempts = 0
  TotErr = 0
  
  PrintE("Await NAK or press start")
  WHILE Receive(10)<>NAK AND attempts<8 AND CONSOL=7 DO ; await initial NAK
    attempts ==+ 1
    PrintF("%CTimeout %U%E",$1C,attempts)
  OD
  IF attempts=8 THEN
    PrintE("Timed out before initial NAK")
    MyClose(file)
    RETURN
  FI
  attempts = 0
  SectNum = 1

  WHILE RBuf()<>0 AND attempts<RETRYMAX DO ; blocks
    IF CIO_status<>1 THEN
      PrintF("DOS error %U%E",CIO_status)
      EXIT
    FI
    attempts = 0
    DO  ; send block
;     PrintF("%Cblock %U%E",$1C,SectNum)
      Send(SOH)
      Send(SectNum)
      Send($FF-SectNum)
      CheckSum = 0
      FOR j = 0 TO 127 DO
        ch=block(j)
        Send(ch)
        CheckSum = CheckSum+ch
      OD
      Send(CheckSum)
      PurgeLine(0)
      attempts ==+ 1
      TotErr == +1
    UNTIL Receive(10)=ACK OR attempts=RETRYMAX OD
    SectNum ==+ 1
    TotErr ==- 1
  OD ; loop on blocks
  IF attempts=RETRYMAX THEN
    PrintE("No ACK on sector")
  ELSE
    attempts=0
    DO
      Send(EOT)
      PurgeLine(0)
      attempts ==+ 1
    UNTIL Receive(10)=ACK OR attempts=RETRYMAX OD
    IF attempts=RETRYMAX THEN
      PrintE("No ACK on EOT")
    FI
  FI
  MyClose(file)
  PrintF("Done with %U retries%E",TotErr)
RETURN ; SndFile

; -----------------------------------
PROC Main()
  BYTE ch
  fbuf = end
  transx = ASCII
;transx=1 ; BINARY
  ch = GetD(7)&$DF
  IF ch='R THEN
    RecFile()
  ELSEIF ch='T OR ch='S THEN
    SndFile()
  FI
  Close(modem)
RETURN