(FILECREATED "12-Jan-85 01:43:54" {ERIS}<LISPCORE>LIBRARY>RS232FTP.;7 49621
changes to: (FNS \RS232FTPINITIALIZE RS232GETFILE \RS232FTPGETPKT RS232PUTFILE)
previous date: " 8-Jan-85 01:53:24" {ERIS}<LISPCORE>LIBRARY>RS232FTP.;6)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RS232FTPCOMS)
(RPAQQ RS232FTPCOMS ((FILES (SYSLOAD)
RS232)
(DECLARE: EVAL@COMPILE DONTCOPY (P (OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))))
(LOCALVARS . T)
(* MODEM ftp protocols)
(DECLARE: DONTCOPY (* Random macros which distinguish between I-10 and I-D (and I-VAX ?))
(MACROS STRINGNCHARS SETSTRINGLENGTH RPLCHARCODE STRINGSUBSTRING \FILLINSTRPTR)
(MACROS MAKEPKT PKTP PKTBYTE SETPKTBYTE PKTLENGTH SETPKTLENGTH PKTROOM)
(CONSTANTS (RS232FTPsoh (CHARCODE ↑A))
(MODEMeot (CHARCODE ↑D))
(MODEMack (CHARCODE ↑F))
(MODEMnak (CHARCODE ↑U))
(MODEMcan (CHARCODE ↑X)))
(* Other random MACROS)
(MACROS BYTEFROM2NIBBLES TRIMTOBITS)
(MACROS GAGALLINTERRUPTS UNGAGINTERRUPTS))
(INITVARS (\RFTPpkt.datalength 128)
(\RFTPsyspkt.datalength 8)
(\RS232PKTBUFFER.SIZE (IPLUS 10 (ITIMES 2 \RFTPpkt.datalength)))
(\RS232PKTBUFFER NIL)
(\RS232PKTSTRPTR (ALLOCSTRING 0))
(\RFTPchartimeout.tics (ITIMES 3 \RCLKSECOND))
(\RFTPpkttimeout.tics (ITIMES 10 \RCLKSECOND))
(\RS232.FTP.BOX (SETUPTIMER 0))
(\RS232FTPSLOW.BaudRate 1200)
(\RS232FTP.FASTMSGW NIL)
(\RS232FTP.FILENAME NIL)
(RS232FTPTRACEFLG NIL)
(RS232FTPTRACEFILE T))
(GLOBALVARS \RFTPpkt.datalength \RFTPsyspkt.datalength \RS232PKTBUFFER.SIZE \RS232PKTBUFFER
\RS232PKTSTRPTR \RFTPchartimeout.tics \RFTPpkttimeout.tics \RS232.FTP.BOX
\RS232FTPSLOW.BaudRate \RS232FTP.FASTMSGW \RS232FTP.FILENAME RS232FTPTRACEFLG)
(SPECVARS STRM 7BIT? 7BITBINARY? MODEM? MODEMTEXT? STRM TWOSECS.tics TWOCHARTIMES.tics
TWOPKTTIMES.tics TWOPKTTIMES.secs LASTPKTP EXPECTED.PKTLEN DOLPHINP EOLProcessing
LastWasCR)
(FNS \RS232FTPINITIALIZE RS232GETFILE \RS232FTPGETPKT \RS232FTPGETCHKSM RS232PUTFILE
\RS232FTPCANCEL \RS232FTPPKTFLUSH)
(COMS (FNS \RS232FTP.MODEMCOMMAND \RS232FTP.DMODEMCOMMAND \RS232FTP.8BITCOMMAND
\RS232FTP.COMMAND)
(ALISTS (RS232COMMANDSLST MODEM MODEMFTP RFTP R8FTP)))))
(FILESLOAD (SYSLOAD)
RS232)
(DECLARE: EVAL@COMPILE DONTCOPY
(OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(* MODEM ftp protocols)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS STRINGNCHARS MACRO (= . NCHARS))
(PUTPROPS STRINGNCHARS DMACRO ((STR)
(ffetch (STRINGP LENGTH) of STR)))
(PUTPROPS SETSTRINGLENGTH MACRO ((STR N)
(SETQ STR (SUBSTRING STR 1 N STR))))
(PUTPROPS SETSTRINGLENGTH DMACRO ((STR N)
(freplace (STRINGP LENGTH) of STR with N)))
(PUTPROPS RPLCHARCODE 10MACRO ((X N CHAR)
(RPLSTRING X N (CHARACTER CHAR))))
(PUTPROPS RPLCHARCODE VAXMACRO ((X N CHAR)
(RPLSTRING X N (CHARACTER CHAR))))
(PUTPROPS STRINGSUBSTRING MACRO (= . SUBSTRING))
(PUTPROPS STRINGSUBSTRING DMACRO (OPENLAMBDA (STR START END OLDPTR)
(replace (STRINGP BASE) of OLDPTR with (fetch (STRINGP BASE) of STR))
(replace (STRINGP LENGTH) of OLDPTR with (ADD1 (IDIFFERENCE (OR (FIXP END)
(STRINGNCHARS STR))
START)))
(replace (STRINGP OFFST) of OLDPTR with (IPLUS (fetch (STRINGP OFFST) of STR)
(SUB1 START)))
OLDPTR))
(PUTPROPS \FILLINSTRPTR DMACRO (OPENLAMBDA (STRPTR STRBASE STROFFST STRLENGTH)
(replace (STRINGP BASE) of STRPTR with STRBASE)
(freplace (STRINGP OFFST) of STRPTR with STROFFST)
(freplace (STRINGP LENGTH) of STRPTR with STRLENGTH)
STRPTR))
(PUTPROPS \FILLINSTRPTR MACRO (OPENLAMBDA (STRPTR STRBASE STROFFST STRLENGTH)
(replace (STRINGP BASE) of STRPTR with STRBASE)
(replace (STRINGP OFFST) of STRPTR with STROFFST)
(replace (STRINGP LENGTH) of STRPTR with STRLENGTH)
STRPTR))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS MAKEPKT MACRO (LAMBDA (SIZE)
(add SIZE 1)
(ARRAY SIZE SIZE)))
(PUTPROPS MAKEPKT DMACRO ((SIZE)
(ALLOCSTRING SIZE)))
(PUTPROPS PKTP MACRO (= . ARRAYP))
(PUTPROPS PKTP DMACRO (= . STRINGP))
(PUTPROPS PKTBYTE MACRO ((PKT I)
(OPENR (IPLUS (LOC PKT)
2 I))))
(PUTPROPS PKTBYTE DMACRO (OPENLAMBDA (PKT I)
(\GETBASEBYTE (ffetch (STRINGP BASE) of PKT)
I)))
(PUTPROPS SETPKTBYTE MACRO ((PKT I BYTE)
(CLOSER (IPLUS (LOC PKT)
2 I)
BYTE)))
(PUTPROPS SETPKTBYTE DMACRO ((PKT I BYTE)
(\PUTBASEBYTE (ffetch (STRINGP BASE) of PKT)
I BYTE)))
(PUTPROPS PKTLENGTH MACRO (OPENLAMBDA (PKT)
(OPENR (IPLUS (LOC PKT)
2
(ARRAYSIZE PKT)))))
(PUTPROPS PKTLENGTH DMACRO ((PKT)
(STRINGNCHARS PKT)))
(PUTPROPS SETPKTLENGTH MACRO (OPENLAMBDA (PKT LEN)
(CLOSER (IPLUS (LOC PKT)
2
(ARRAYSIZE PKT))
LEN)))
(PUTPROPS SETPKTLENGTH DMACRO ((PKT LEN)
(SETSTRINGLENGTH PKT LEN)))
(PUTPROPS PKTROOM MACRO ((PKT)
(SUB1 (ARRAYSIZE PKT))))
(PUTPROPS PKTROOM DMACRO ((PKT)
(PKTLENGTH PKT)))
)
(DECLARE: EVAL@COMPILE
(RPAQ RS232FTPsoh (CHARCODE ↑A))
(RPAQ MODEMeot (CHARCODE ↑D))
(RPAQ MODEMack (CHARCODE ↑F))
(RPAQ MODEMnak (CHARCODE ↑U))
(RPAQ MODEMcan (CHARCODE ↑X))
(CONSTANTS (RS232FTPsoh (CHARCODE ↑A))
(MODEMeot (CHARCODE ↑D))
(MODEMack (CHARCODE ↑F))
(MODEMnak (CHARCODE ↑U))
(MODEMcan (CHARCODE ↑X)))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS BYTEFROM2NIBBLES MACRO ((N1 N2)
(LOGOR (LLSH N1 BITSPERNIBBLE)
N2)))
(PUTPROPS TRIMTOBITS MACRO (X
(PROG ((NBITS (CONSTANTEXPRESSIONP (CAR X)))
(VAL (CADR X)))
(RETURN (if NBITS
then (if (NOT (CONSTANTEXPRESSIONP VAL))
then (LIST (QUOTE LOGAND)
(SUBST (CAR NBITS)
(QUOTE NBITS)
(QUOTE (CONSTANT (SUB1 (LLSH 1 NBITS)))))
VAL)
else (LOGAND (CAR (CONSTANTEXPRESSIONP VAL))
(SUB1 (LLSH 1 (CAR NBITS)))))
else (LIST (QUOTE LOGAND)
(LIST (QUOTE SUB1)
(LIST (QUOTE LLSH)
1
(CAR X)))
VAL))))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS GAGALLINTERRUPTS MACRO (NIL
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(\PUTBASE (EMADDRESS ACTIVE.EM)
0 0)))
(PUTPROPS UNGAGINTERRUPTS MACRO (OPENLAMBDA (L)
(\PUTBASE \EM.DISPINTERRUPT 0 (CAR L))
(\PUTBASE (EMADDRESS ACTIVE.EM)
0
(CADR L))))
)
)
(RPAQ? \RFTPpkt.datalength 128)
(RPAQ? \RFTPsyspkt.datalength 8)
(RPAQ? \RS232PKTBUFFER.SIZE (IPLUS 10 (ITIMES 2 \RFTPpkt.datalength)))
(RPAQ? \RS232PKTBUFFER NIL)
(RPAQ? \RS232PKTSTRPTR (ALLOCSTRING 0))
(RPAQ? \RFTPchartimeout.tics (ITIMES 3 \RCLKSECOND))
(RPAQ? \RFTPpkttimeout.tics (ITIMES 10 \RCLKSECOND))
(RPAQ? \RS232.FTP.BOX (SETUPTIMER 0))
(RPAQ? \RS232FTPSLOW.BaudRate 1200)
(RPAQ? \RS232FTP.FASTMSGW NIL)
(RPAQ? \RS232FTP.FILENAME NIL)
(RPAQ? RS232FTPTRACEFLG NIL)
(RPAQ? RS232FTPTRACEFILE T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RFTPpkt.datalength \RFTPsyspkt.datalength \RS232PKTBUFFER.SIZE \RS232PKTBUFFER
\RS232PKTSTRPTR \RFTPchartimeout.tics \RFTPpkttimeout.tics \RS232.FTP.BOX
\RS232FTPSLOW.BaudRate \RS232FTP.FASTMSGW \RS232FTP.FILENAME RS232FTPTRACEFLG)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS STRM 7BIT? 7BITBINARY? MODEM? MODEMTEXT? STRM TWOSECS.tics TWOCHARTIMES.tics
TWOPKTTIMES.tics TWOPKTTIMES.secs LASTPKTP EXPECTED.PKTLEN DOLPHINP EOLProcessing LastWasCR)
)
(DEFINEQ
(\RS232FTPINITIALIZE
(LAMBDA (OPERATION) (* JonL "12-Jan-85 01:31")
(RS232INITIALIZECHECK)
(until (if (NNLITATOM FILENAME.or.STREAM)
then (if (OPENP FILENAME.or.STREAM (QUOTE OUTPUT))
then (SETQ FILENAME.or.STREAM (GETSTREAM FILENAME.or.STREAM))
else (NOT (OPENP FILENAME.or.STREAM (QUOTE INPUT))))
else (AND (type? STREAM FILENAME.or.STREAM)
(WRITEABLE FILENAME.or.STREAM)
(EQ BITSPERBYTE (fetch (STREAM BYTESIZE) of FILENAME.or.STREAM))))
do (SETQ FILENAME.or.STREAM (ERROR "Bad File (or Stream) specification." FILENAME.or.STREAM)))
((LAMBDA (OSTREAMTYPE)
(until (SELECTQ FILETYPE
(NIL (SETQ FILETYPE (OR OSTREAMTYPE (QUOTE TEXT))))
((TEXT ASCII)
(if (MEMB OSTREAMTYPE (QUOTE (NIL TEXT)))
then (SETQ FILETYPE (QUOTE TEXT))))
((BINARY)
(if (MEMB OSTREAMTYPE (QUOTE (NIL BINARY)))
then (SETQ FILETYPE (QUOTE BINARY))))
NIL)
do (SETQ FILETYPE (ERROR (if OSTREAMTYPE
then "Already-open stream has different file type"
else "Unrecognized file type")
FILETYPE))))
(CAR (NLSETQ (AND (NOT (LITATOM FILENAME.or.STREAM))
(GETFILEINFO FILENAME.or.STREAM (QUOTE TYPE))))))
(bind TEM until (SETQ TEM (SELECTQ PROTOCOL
(MODEM (QUOTE MODEM))
(DMODEM (SETQ EOLProcessing T)
(QUOTE MODEM))
(KERMIT (HELP "Kermit protocol not yet implemented!"))
NIL))
do (SETQ PROTOCOL (ERROR "Unrecognized protocol" PROTOCOL)) finally (SETQ PROTOCOL TEM))
(RESETSAVE NIL (QUOTE (AND RESETSTATE (\RS232FTPCANCEL))))
(if (LITATOM FILENAME.or.STREAM)
then (RESETSAVE (SETQ STRM (OPENSTREAM FILENAME.or.STREAM (SELECTQ OPERATION
(GET (QUOTE OUTPUT))
(PUT (QUOTE INPUT))
(SHOULDNT))
NIL BITSPERBYTE (LIST (LIST (QUOTE TYPE)
FILETYPE))))
(QUOTE (PROGN (CLOSEF? OLDVALUE))))
else (SETQ STRM FILENAME.or.STREAM))
(if (OR (NOT (PKTP \RS232PKTBUFFER))
(NOT (ILEQ \RS232PKTBUFFER.SIZE (PKTROOM \RS232PKTBUFFER))))
then (SETQ \RS232PKTBUFFER (MAKEPKT \RS232PKTBUFFER.SIZE)))
(SETQ DOLPHINP (EQ (MACHINETYPE)
(QUOTE DOLPHIN)))
(CHECKUART)
(SETQ MODEM? (EQ PROTOCOL (QUOTE MODEM)))
(SETQ MODEMTEXT? (AND MODEM? (EQ FILETYPE (QUOTE TEXT))))
(SETQ TWOPKTTIMES.tics (ITIMES \RS232.ByteIntervalCap.tics (ITIMES 2 \RFTPpkt.datalength)))
(SETQ TWOPKTTIMES.secs (IQUOTIENT (IPLUS TWOPKTTIMES.tics (SUB1 \RCLKSECOND))
\RCLKSECOND))
(SETQ \RFTPchartimeout.tics (ITIMES 3 \RCLKSECOND))
(SETQ \RFTPpkttimeout.tics (ITIMES 10 \RCLKSECOND))
(if (ILESSP (fetch (RS232CHARACTERISTICS BITSPERCHAR) of RS232INIT)
(SELECTQ PROTOCOL
((MODEM DMODEM)
8)
((KERMIT)
7)
0))
then (* Lose, if we ask for 8-bit mode on a host/UART that
is doing 7bit.)
(ERROR "Wrong # bits per serial char for this protocol." PROTOCOL))
(SETQ EXPECTED.PKTLEN \RFTPpkt.datalength)
(if (EQ OPERATION (QUOTE PUT))
then (SETQ FILELEN (GETFILEINFO STRM (QUOTE LENGTH))))
(if RS232FTPTRACEFLG
then (printout RS232FTPTRACEFILE T OPERATION " (" (L-CASE FILETYPE)
(SELECTQ OPERATION
(GET ") to ")
") from ")
(FULLNAME STRM)
", PROTOCOL = " PROTOCOL T " Expected PKT length = " EXPECTED.PKTLEN
", 2 PKT times = "
TWOPKTTIMES.secs " seconds." T)
(if (EQ OPERATION (QUOTE PUT))
then (printout RS232FTPTRACEFILE " (File length = " FILELEN " bytes, "
(IQUOTIENT (IPLUS FILELEN 127)
128)
" sectors) " T)))
(FRPTQ 20 (BLOCK)) (* Last chance for some other guys to sneak in a bit.)
(RESETSAVE RECLAIMWAIT MAX.SMALLP)
(RS232MODEMCONTROL (QUOTE (DTR RTS))) (* Touch a bunch of things just to be sure that they
are swapped in.)
(if (AND (PROG1 DOLPHINP (* Comment PPLossage))
(IGREATERP (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT)
\RS232FTPSLOW.BaudRate))
then (* (EMADDRESS ACTIVE.EM) is the address of an interrupt
mask word for the Dolphin)
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (L)
(\PUTBASE \EM.DISPINTERRUPT 0 (CAR L))
(\PUTBASE (EMADDRESS ACTIVE.EM)
0
(CADR L))))
(SETQ HIGHSPEEDDOLPHINP (LIST (\GETBASE \EM.DISPINTERRUPT 0)
(\GETBASE (EMADDRESS ACTIVE.EM)
0)))))
(if (NOT (WINDOWP \RS232FTP.FASTMSGW))
then (SETQ \RS232FTP.FASTMSGW (CREATEW (CONSTANT ((LAMBDA (H)
(* H is the Height necessary for 4 lines of text.)
(create REGION
LEFT ← 10
BOTTOM ←(IDIFFERENCE
SCREENHEIGHT H)
WIDTH ←(IDIFFERENCE
SCREENWIDTH 20)
HEIGHT ← H))
(TIMES 4 (IABS (DSPLINEFEED
NIL
WindowTitleDisplayStream)))))
NIL 0 T))
(DSPFONT (DSPFONT NIL WindowTitleDisplayStream)
\RS232FTP.FASTMSGW))
((LAMBDA (REG)
(RESETSAVE (SETDISPLAYHEIGHT (fetch HEIGHT of REG)))
(if (AND (PROG1 RS232FTPTRACEFILE (* Comment PPLossage))
(DISPLAYSTREAMP (GETSTREAM RS232FTPTRACEFILE)))
then (RESETSAVE RS232FTPTRACEFILE \RS232FTP.FASTMSGW))
(RESETSAVE NIL (QUOTE (PROGN (CLOSEW \RS232FTP.FASTMSGW))))
(DSPRESET \RS232FTP.FASTMSGW)
((LAMBDA (Y)
(DSPXPOSITION (IQUOTIENT (fetch WIDTH of REG)
2)
\RS232FTP.FASTMSGW)
(PRIN3 "Trimming Display to achieve high speed for Dolphin" \RS232FTP.FASTMSGW)
(MOVETO 0 Y \RS232FTP.FASTMSGW))
(DSPYPOSITION NIL \RS232FTP.FASTMSGW)))
(WINDOWPROP \RS232FTP.FASTMSGW (QUOTE REGION))))
(MAPC (CONSTANT (APPEND (LDIFFERENCE (FILECOMSLST (QUOTE RS232FTP)
(QUOTE VARS))
(CONS (QUOTE RS232FTPCOMS)
(FILECOMSLST (QUOTE RS232FTP)
(QUOTE CONSTANTS))))
(QUOTE (\TIMEREXPIRED.BOX \RS232IRBLO \RS232IRBHI \RS232.TIMEOUT.BOX
\RS232.MAX#BYTESPERLOOP \RS232.THRE.BOX
\RS232.ERROR.MASK))))
(FUNCTION EVALV))
(MAPC (SELECTQ OPERATION
(GET (DEFERREDCONSTANT (CONS (QUOTE \RS232INSURE.LINEBUFFER)
(\ONPATHS.CCODE (QUOTE (RS232GETFILE))
(QUOTE (\RS232INSURE.LINEBUFFER
MACHINETYPE
\RS232FTPINITIALIZE
\RS232FTP.CANCEL RS232LOGIN
RS232.PROMPTFORLOGIN BLOCK
\GETBASESTRING CLOSEF?
CLOSEF \GETOFD GETFILEINFO
APPLY ERROR ERROR!
\LISPERROR ERRORX RAID HELP
SHOULDNT RESETRESTORE
\PRINDATUM \DAYTIME0
\ILLEGAL.ARG \PAGEDBOUTS
\PAGEDBINS \BACKGROUND
\STOP.DRIBBLE? \MAPCHARS
NCHARS ALLOCSTRING MKSTRING
TERPRI PRIN1
\CanonicalizeTimerUnits
RS232CLEARBUFFER
NOTIFY.EVENT))
65535))))
(PUT (DEFERREDCONSTANT (CONS (QUOTE \RS232INSURE.LINEBUFFER)
(\ONPATHS.CCODE (QUOTE (RS232PUTFILE))
(QUOTE (\RS232INSURE.LINEBUFFER
MACHINETYPE
\RS232FTPINITIALIZE
\RS232FTP.CANCEL RS232LOGIN
RS232.PROMPTFORLOGIN BLOCK
\GETBASESTRING CLOSEF?
CLOSEF \GETOFD GETFILEINFO
APPLY ERROR ERROR!
\LISPERROR ERRORX RAID HELP
SHOULDNT RESETRESTORE
\PRINDATUM \DAYTIME0
\ILLEGAL.ARG \PAGEDBOUTS
\PAGEDBINS \BACKGROUND
\STOP.DRIBBLE? \MAPCHARS
NCHARS ALLOCSTRING MKSTRING
TERPRI PRIN1
\CanonicalizeTimerUnits
RS232CLEARBUFFER
NOTIFY.EVENT))
65535))))
(SHOULDNT))
(FUNCTION \FRESHENUPFN))
(if REMOTE.COMMAND.STR
then (for C instring (MKSTRING REMOTE.COMMAND.STR)
do (RS232WRITEBYTE C T)
(\RS232CHECK.BLOCK 50)) (* Note that even if REMOTE.COMMAND.STR has an EOL at
the end, this character will just be a spuriously sent
one.)
(RS232WRITEBYTE (CHARCODE EOL)
T))))
(RS232GETFILE
(LAMBDA (FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR)
(* JonL "12-Jan-85 01:37")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR))
(* This will be set up by \RS232FTPINITIALIZE but want
a reasonable value before doing the RESETSAVE)
(RESETLST (RESETSAVE (RS232XON\XOFF? NIL))
(PROG ((FIRSTPKTP T)
(LASTPKTP)
(SYSPKTP)
(FILELEN 0)
(BLK# 1)
(#NAKS.THIS.PKT -1)
(NAKCAUSE)
DOLPHINP MODEM? MODEMTEXT? KERMIT? STRM EXPECTED.FILELEN EXPECTED.PKTLEN
EOLProcessing LastWasCR #CHKSMBYTES PKTLEN FIRSTBYTE PKTBLK# PKTBLK#.complement
TWOPKTTIMES.tics TWOPKTTIMES.secs HIGHSPEEDDOLPHINP PKT PROMPTBYTE)
(DECLARE (SPECVARS STRM MODEM? MODEMTEXT? KERMIT? TWOPKTTIMES.tics
TWOPKTTIMES.secs LASTPKTP EXPECTED.PKTLEN DOLPHINP
EOLProcessing LastWasCR HIGHSPEEDDOLPHINP FILELEN))
(\RS232FTPINITIALIZE (QUOTE GET)) (* We count the checksum bytes on the GET side.
Note that in 7BIT mode, the checksum is delivered in
nibbles.)
(SETQ #CHKSMBYTES (if (OR MODEM? KERMIT?)
then 1
else 1))
NAK (SETQ PROMPTBYTE MODEMnak)
(SETQ LASTPKTP (SETQ EOLProcessing)) (* If we have to NAK on the last packet, then don't be
misled.)
(if (ILESSP 10 (add #NAKS.THIS.PKT 1))
then (RETURN "Packet receipt failed after 10 tries."))
(\RS232CHECK.BLOCK (if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS HIGHSPEEDDOLPHINP)
20))
(if (AND RS232FTPTRACEFLG NAKCAUSE)
then (if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE -)
RS232FTPTRACEFILE)
else (printout RS232FTPTRACEFILE T "NAKing on block number " BLK#
" for the "
#NAKS.THIS.PKT
(ORDINALSUFFIXSTRING #NAKS.THIS.PKT)
" time, because: " NAKCAUSE)))
(\RS232FTPPKTFLUSH (if (IGREATERP #NAKS.THIS.PKT 0)
then TWOPKTTIMES.tics
else
(* Upon initial entry into this packet-getting loop, the value of #NAKS.THIS.PKT is -1 so that it immediately
becomes 0; thus we start off the NAKing quickly, rather than waiting for a 10-sec timeout.)
\RS232.Tovh&BIC16.tics)
T)
GETNXTPKT
(for CNT to 10
do (if HIGHSPEEDDOLPHINP
then (GAGALLINTERRUPTS))
(RS232WRITEBYTE PROMPTBYTE T)
(during \RFTPpkttimeout.tics timerUnits (QUOTE TICKS) usingTimer
\RS232.FTP.BOX
when (SETQ FIRSTBYTE (RS232READBYTE))
do (SELECTC FIRSTBYTE
(RS232FTPsoh (if LASTPKTP
then (SETQ NAKCAUSE
"EOT expected, but SOH received")
(GO NAK)
else (SETQ SYSPKTP)
(GO GETBLK#)))
(if MODEM?
then (SELECTC FIRSTBYTE
(MODEMeot (if (OR LASTPKTP MODEM?)
then (GO DONE)
else (SETQ NAKCAUSE
"EOT received before expected")
(GO NAK)))
(MODEMcan (if MODEM?
then (SETQ NAKCAUSE
"SOH expected, but CANcel received")
(GO NAK))
(SETQ SYSPKTP T)
(GO GETBLK#))
NIL))))
(\RS232CHECK.BLOCK (if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS HIGHSPEEDDOLPHINP)
20))
(if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE %.)
RS232FTPTRACEFILE)
elseif RS232FTPTRACEFLG
then (printout RS232FTPTRACEFILE T (if MODEM?
then (SELECTC PROMPTBYTE
(MODEMack "Re-ACK")
(MODEMnak "Re-NAK")
(SHOULDNT
PROMPTBYTE))
else "Try")
"ing to begin block number " BLK# ", for the " CNT
(ORDINALSUFFIXSTRING CNT)
" time.")))
(RETURN (if (ILEQ 1 BLK#)
then "Can't establish protocol with remote host."
else "Timed out waiting for next packet."))
GETBLK#
(if (NOT (AND (SETQ PKTBLK# (RS232READBYTE \RFTPchartimeout.tics (QUOTE TICKS)))
(SETQ PKTBLK#.complement (RS232READBYTE \RFTPchartimeout.tics
(QUOTE TICKS)))))
then (SETQ NAKCAUSE "Timed out on packet BLK# bytes")
(GO NAK)
elseif (NEQ PKTBLK# (TRIMTOBITS BITSPERBYTE (LOGNOT PKTBLK#.complement)))
then (if RS232FTPTRACEFLG
then (SETQ NAKCAUSE (OR (EQ RS232FTPTRACEFLG (QUOTE PEEK))
(LIST "BLK# complement loses" PKTBLK#
PKTBLK#.complement))))
(GO NAK)
elseif (IGREATERP PKTBLK# BLK#)
then (* Block number bytes don't check out)
(SETQ NAKCAUSE "BLK# out of order")
(AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK))
(SETQ NAKCAUSE (LIST NAKCAUSE PKTBLK# BLK#)))
(GO NAK)
elseif (ILESSP PKTBLK# BLK#)
then (* Multiple receipt of a pkt;
just ignore it, but ACK to get next pkt.)
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC4.tics TWOPKTTIMES.tics)
(GO ACK))
(SETQ PKT (\RS232FTPGETPKT (if SYSPKTP
then \RFTPsyspkt.datalength
elseif KERMIT?
then (HELP "Not yet implemented")
elseif (AND FIRSTPKTP (NOT MODEM?))
then 3
else EXPECTED.PKTLEN)
#CHKSMBYTES MODEM? MODEMTEXT? EOLProcessing LastWasCR))
(if (NOT (PKTP PKT))
then (SETQ NAKCAUSE (if (LISTP PKT)
then (APPLY (QUOTE CONCAT)
PKT)
else "Tried, but failed to get a packet"))
(GO NAK)
elseif (\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOPKTTIMES.tics)
then (* Hmmm, no characters should have been coming in at
this time)
(SETQ NAKCAUSE "Extra bytes coming in after PKT is complete")
(GO NAK)
elseif (AND LASTPKTP MODEMTEXT?)
then (if (NEQ (PKTBYTE PKT LASTPKTP)
(CHARCODE ↑Z))
then (SETQ NAKCAUSE (AND (PROG1 RS232FTPTRACEFLG
(* Comment PPLossage))
(OR (EQ RS232FTPTRACEFLG (QUOTE PEEK))
(LIST "LASTPKTP = " LASTPKTP
", but charcode there is "
(PKTBYTE PKT LASTPKTP)))))
(GO NAK)
elseif (ZEROP LASTPKTP)
then (GO DONE)) (* Remember, LASTPKTP is 0-origined)
(SETPKTLENGTH PKT LASTPKTP))
(if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS HIGHSPEEDDOLPHINP))
(if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE +)
RS232FTPTRACEFILE)
elseif RS232FTPTRACEFLG
then (printout RS232FTPTRACEFILE T "Received"
(if SYSPKTP
then " System"
else "")
" PKT with block number " BLK#))
(if MODEM?
then NIL
elseif SYSPKTP
then
(* In non-MODEM protocols, we have a "system" packet concept, which uses the current BLK# but doesn't increment it.
This is a much safer way, for example, to send an "abort" signal.)
(SHOULDNT "System packets not yet implemented")
(GO ACK))
(SETQ BLK# (TRIMTOBITS BITSPERBYTE (ADD1 BLK#)))
(SETQ PKTLEN (PKTLENGTH PKT))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout T "; and writing it to file."))
(\BOUTS STRM (ffetch (STRINGP BASE) of PKT)
0 PKTLEN)
(add FILELEN PKTLEN)
(BLOCK) (* FOOFOOFOO ought to allow Ethernet processes to run,
in case we are storing the file remotely)
ACK (SETQ #NAKS.THIS.PKT 0)
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T "ACKing block number " PKTBLK#))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC4.tics TWOPKTTIMES.tics)
(SETQ FIRSTPKTP)
(SETQ PROMPTBYTE MODEMack)
(GO GETNXTPKT)
DONE(if (AND EOLProcessing LastWasCR)
then (* Random case where last byte of a file is a CR)
(BOUT STRM (CHARCODE LF)))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T "EOT received -- final ACK being sent." T))
(RS232WRITEBYTE MODEMack T)
(if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS HIGHSPEEDDOLPHINP))
(if (LITATOM FILENAME.or.STREAM)
then (CLOSEF STRM))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOPKTTIMES.tics)
(BLOCK)
(RETURN FILELEN)))))
(\RS232FTPGETPKT
(LAMBDA (#BYTES #CHKSMBYTES MODEM? MODEMTEXT? EOLProcessing ILASTWASCR)
(DECLARE (SPECVARS MODEM? MODEMTEXT? KERMIT? LASTPKTP DOLPHINP EOLProcessing))
(* JonL "12-Jan-85 01:43")
(* This guy gobbles up the next #BYTES bytes as the incoming packet, and does the packet check-summing operation
over the next #CHKSMBYTES bytes. Returns the valid packet, or NIL if it is somehow invalid. WARNING! For
Interlisp-D, the PKT must be a STRINGP with OFFST of 0 Also sets LASTPKTP if it is a MODEM TEXT transfer and a ↑Z is
encountered.)
(PROG ((STRSM 0)
(#XTRALFS (AND EOLProcessing 0))
PKT PKTLEN C CHKSM)
(DECLARE (LOCALVARS STRSM PKT PKTLEN C CHKSM))
(SERVICEIRING)
(\FILLINSTRPTR (PROG1 \RS232PKTSTRPTR (* Comment PPLossage))
(ffetch (STRINGP BASE) of \RS232PKTBUFFER)
0
(OR (FIXP #BYTES)
(IPLUS (STRINGNCHARS \RS232PKTBUFFER)
(ffetch (STRINGP OFFST) of \RS232PKTBUFFER))))
(* Note: several places depend upon this OFFST being 0)
(SETQ PKT \RS232PKTSTRPTR)
(if (AND DOLPHINP (PROG1 (ILESSP \RS232FTPSLOW.BaudRate (fetch (RS232CHARACTERISTICS
BAUDRATE)
of RS232INIT))
(SERVICEIRING)))
then (* This is the special casing for the DOLPHIN since it
should use RS232READSTRING in the faster cases)
(SETQ PKT (RS232READSTRING #BYTES NIL T \RFTPchartimeout.tics (QUOTE TICKS)
PKT))
(if (NOT (STRINGP PKT))
then (RETURN (QUOTE ("Timeout during receipt of PKT")))
elseif (NEQ #BYTES (SETQ PKTLEN (STRINGNCHARS PKT)))
then (GO SHORTPKTP))
(AND DOLPHINP (SERVICEIRING))
(OR (SETQ CHKSM (\RS232FTPGETCHKSM #CHKSMBYTES))
(GO SHORTPKTP))
(SETQ STRSM (for C instring PKT as I from 0
sum (if (NOT MODEMTEXT?)
then NIL
elseif (AND (NOT LASTPKTP)
(EQ C (CHARCODE ↑Z)))
then (SETQ LASTPKTP I)
elseif (NULL #XTRALFS)
then NIL
else (if (AND (NOT ILASTWASCR)
(EQ C (CHARCODE LF)))
then (add #XTRALFS 1))
(SETQ ILASTWASCR (EQ C (CHARCODE CR))))
C))
else (* Note that the Dolphin only comes here if the baud
rate is slow.)
(SETQ PKTLEN 0) (* We maintain this as a running counter, just in case
the SHORTPKTP branch is taken.)
(for I from 0 to (SUB1 #BYTES)
do (OR (SETQ C (RS232READBYTE \RFTPchartimeout.tics (QUOTE TICKS)))
(GO SHORTPKTP))
(add PKTLEN 1)
(if MODEMTEXT?
then (if (AND (NOT LASTPKTP)
(EQ C (CHARCODE ↑Z)))
then (* Find the 0-origin index of a ↑Z in the last packet
of MODEMTEXT? mode)
(SETQ LASTPKTP I))
(if #XTRALFS
then (AND ILASTWASCR (EQ C (CHARCODE LF))
(add #XTRALFS 1))
(SETQ ILASTWASCR (EQ C (CHARCODE CR)))))
(SETPKTBYTE PKT I C)
(add STRSM C))
(AND DOLPHINP (SERVICEIRING))
(OR (SETQ CHKSM (\RS232FTPGETCHKSM #CHKSMBYTES))
(GO SHORTPKTP))
(SETPKTLENGTH PKT PKTLEN)) (* Trim down the sum-of-bytes to the proper size.
For MODEM protocol, it is only 8 bits, but for others
it is "word" size.)
(SETQ C (TRIMTOBITS BITSPERBYTE STRSM))
(RETURN (if (IEQP CHKSM C)
then (if (AND #XTRALFS (NEQ 0 #XTRALFS))
then (bind (LCR? ← LastWasCR) for I from 0 to (IDIFFERENCE
(SUB1 PKTLEN)
#XTRALFS)
as J from 0
do (SETQ C (PKTBYTE PKT J))
(if (AND LCR? (EQ C (CHARCODE LF)))
then (SETQ C (PKTBYTE PKT (add J 1))))
(SETPKTBYTE PKT I C)
(SETQ LCR? (EQ C (CHARCODE CR))))
(SETPKTLENGTH PKT (IDIFFERENCE PKTLEN #XTRALFS))
(* Following amounts to a "multiple" return value)
(SETQ LastWasCR ILASTWASCR))
PKT
elseif RS232FTPTRACEFLG
then (* Sigh, a check sum error)
(OR (EQ RS232FTPTRACEFLG (QUOTE PEEK))
(LIST "Check sum error. PKT contained " CHKSM ", I computed " C))))
SHORTPKTP
(RETURN (if RS232FTPTRACEFLG
then (OR (EQ RS232FTPTRACEFLG (QUOTE PEEK))
(LIST "Short packet; length = " PKTLEN ", Expected length was "
#BYTES)))))))
(\RS232FTPGETCHKSM
(LAMBDA (#CHKSMBYTES) (* JonL " 6-JAN-83 04:20")
(* NOTE WELL: we must have #CHKSMBYTES = 1 when MODEM?)
(SELECTC #CHKSMBYTES
(1 (RS232READBYTE \RFTPchartimeout.tics (QUOTE TICS)))
(2 (RS232READWORD \RFTPchartimeout.tics (QUOTE TICS)))
(4 ((LAMBDA (W1 W2)
(if (AND (SETQ W1 (RS232READWORD \RFTPchartimeout.tics (QUOTE TICS)))
(SETQ W2 (RS232READWORD \RFTPchartimeout.tics (QUOTE TICS))))
then (create WORD
HIBYTE ←(BYTEFROM2NIBBLES (fetch (WORD HIBYTE) of W1)
(fetch (WORD LOBYTE) of W1))
LOBYTE ←(BYTEFROM2NIBBLES (fetch (WORD HIBYTE) of W2)
(fetch (WORD LOBYTE) of W2)))))))
(SHOULDNT))))
(RS232PUTFILE
(LAMBDA (FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR XON\XOFF?)
(* JonL "12-Jan-85 01:33")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR))
(RESETLST (RESETSAVE RS232XON\XOFF? XON\XOFF?)
(PROG ((BLK# 1)
(FIRSTPKTP T)
(#RESENDS.THIS.PKT -1)
(NAKCAUSE)
(10SECS.tics (ITIMES 10 \RCLKSECOND))
TWOPKTTIMES.tics TWOPKTTIMES.secs DOLPHINP 7BITBINARY? MODEM? MODEMTEXT? STRM
FILELEN EXPECTED.PKTLEN PKTLEN PKTBLK# PKTBLK#.complement BYTE CHKSM
EOLProcessing #LOSTLFS)
(DECLARE (SPECVARS STRM MODEM? MODEMTEXT? TWOPKTTIMES.tics TWOPKTTIMES.secs
LASTPKTP EXPECTED.PKTLEN DOLPHINP EOLProcessing FILELEN))
(\RS232FTPINITIALIZE (QUOTE PUT))
(for I to (PROG1 10 (* Comment PPLossage))
do (if (during (PROG1 10SECS.tics (* Comment PPLossage)) find
old BYTE suchthat (EQ MODEMnak (SETQ BYTE (RS232READBYTE)))
timerUnits (QUOTE TICKS) usingBox \RS232.FTP.BOX)
then (RETURN)
elseif RS232FTPTRACEFLG
then (if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE %.)
RS232FTPTRACEFILE)
else (printout RS232FTPTRACEFILE T "No response yet after "
(ITIMES I 10)
" seconds of waiting")))
finally (RETURN "Never received first NAK"))
RETRANSMIT
(if (ILESSP 10 (add #RESENDS.THIS.PKT 1))
then (RETURN "Packet transmission not acknowledged, after 10 tries.")
elseif (AND RS232FTPTRACEFLG (IGEQ #RESENDS.THIS.PKT 1))
then (if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE -)
RS232FTPTRACEFILE)
else (printout RS232FTPTRACEFILE T
"Re-transmitting PKT with block number "
BLK# " for the " #RESENDS.THIS.PKT (ORDINALSUFFIXSTRING
#RESENDS.THIS.PKT)
" time.")))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOPKTTIMES.tics)
PUTNXTPKT (* Prepare the data in a buffer first, before sending
out RS232FTPsoh)
(if (ZEROP #RESENDS.THIS.PKT)
then (SETQ #LOSTLFS 0)
(if (AND FIRSTPKTP (NOT MODEM?))
then (* Boy, How I'd like to use a bunch of LOADBYTE's
here!)
(SETQ PKTLEN 3)
(SETQ BYTE (TRIMTOBITS 7 FILELEN))
(SETPKTBYTE \RS232PKTBUFFER 2 (SETQ CHKSM BYTE))
(SETQ BYTE (LRSH FILELEN 7))
(SETPKTBYTE \RS232PKTBUFFER 1 (TRIMTOBITS 7 BYTE))
(add CHKSM (TRIMTOBITS 7 BYTE))
(SETQ BYTE (TRIMTOBITS 7 (LRSH BYTE 7)))
(SETPKTBYTE \RS232PKTBUFFER 0 BYTE)
(add CHKSM BYTE)
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T
"Sending length block; file length = "
FILELEN))
else (if (NOT EOLProcessing)
then (SETQ PKTLEN (IMIN \RFTPpkt.datalength FILELEN))
(\BINS STRM (ffetch (STRINGP BASE) of \RS232PKTBUFFER)
0 PKTLEN)
(SETPKTLENGTH \RS232PKTBUFFER PKTLEN)
(SETQ CHKSM (for C instring \RS232PKTBUFFER
sum C))
else (SETQ PKTLEN (SETQ CHKSM 0))
(for I from 0 to (SUB1 \RFTPpkt.datalength) as #BINS
from 1 to FILELEN
do (SETQ BYTE (BIN STRM))
(if EOLProcessing
then (if (AND LastWasCR (EQ BYTE (CHARCODE
LF)))
then (if (ILESSP FILELEN
(add #BINS 1))
then (RETURN))
(SETQ BYTE (BIN STRM))
(add #LOSTLFS 1)
(SETQ LastWasCR)
else (SETQ LastWasCR (EQ BYTE
(CHARCODE CR)))))
(SETPKTBYTE \RS232PKTBUFFER I BYTE)
(add CHKSM BYTE)
(add PKTLEN 1)))
(if (AND MODEM? (NEQ PKTLEN \RFTPpkt.datalength))
then (* No short packets in the MODEM protocol!)
(SETPKTLENGTH \RS232PKTBUFFER \RFTPpkt.datalength)
(bind (PAD ←(if MODEMTEXT?
then (add CHKSM (ITIMES (IDIFFERENCE
\RFTPpkt.datalength
PKTLEN)
(CHARCODE ↑Z)))
(CHARCODE ↑Z)
else 0))
for I from PKTLEN to (SUB1 \RFTPpkt.datalength)
do (SETPKTBYTE \RS232PKTBUFFER I PAD))
(SETQ PKTLEN \RFTPpkt.datalength))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T "Sending BLK# " BLK#)))
(SETPKTLENGTH \RS232PKTBUFFER PKTLEN)
(SETQ CHKSM (if MODEM?
then (TRIMTOBITS BITSPERBYTE CHKSM)
else (TRIMTOBITS (CONSTANT (TIMES 2 BITSPERBYTE))
CHKSM))))
(RS232WRITEBYTE RS232FTPsoh T)
PUTBLK#
(SETQ PKTBLK#.complement (TRIMTOBITS BITSPERBYTE (LOGXOR -1 BLK#)))
(RS232WRITEBYTE BLK#)
(RS232WRITEBYTE PKTBLK#.complement)
PUTPKTDATA
(RS232FORCEOUTPUT)
(if (NULL RS232XON\XOFF?)
then (RS232WRITESTRING \RS232PKTBUFFER T 1 PKTLEN)
else (for I from 0 to (SUB1 PKTLEN)
do (* Note that if remote correspondent sends us a ↑S,
then we gag until he sends a ↑Q)
(if (AND RS232XON\XOFF? RS232XOFF?)
then (during TWOPKTTIMES.tics timerUnits (QUOTE TICKS)
usingTimer \RS232.FTP.BOX
do (CHECKUART)
(if (NULL RS232XOFF?)
then (RETURN))
finally (GO RETRANSMIT)))
(RS232WRITEBYTE (PKTBYTE \RS232PKTBUFFER I)
T T)))
PUTCHKSM
(if MODEM?
then (RS232WRITEBYTE CHKSM T)
else (SHOULDNT (QUOTE PROTOCOL)))
WAITFORACK
(during \RFTPpkttimeout.tics usingTimer \RS232.FTP.BOX timerUnits (QUOTE TICKS)
until (AND (SETQ BYTE (RS232READBYTE))
(OR (EQ MODEMack BYTE)
(EQ MODEMnak BYTE))))
(BLOCK) (* Phooey, have to let Ether processes run now and then
-- suppose we are getting the file from some server)
(if (NEQ BYTE MODEMack)
then (if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (if (OR (NOT (SMALLP BYTE))
(EQ BYTE MODEMnak))
then (printout RS232FTPTRACEFILE T (if (EQ BYTE MODEMnak)
then
"Received NAK for this block"
else
"Timeout for this block"))
else (printout RS232FTPTRACEFILE T "Received garbage (" BYTE
") instead of ACK for this block")))
(GO RETRANSMIT)
elseif RS232FTPTRACEFLG
then (if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE +)
RS232FTPTRACEFILE)
else (printout RS232FTPTRACEFILE T "Received ACK for this block")))
(if (ILESSP 0 (SETQ FILELEN (IDIFFERENCE FILELEN (IPLUS PKTLEN #LOSTLFS))))
then (SETQ BLK# (TRIMTOBITS BITSPERBYTE (ADD1 BLK#)))
(SETQ #RESENDS.THIS.PKT 0)
(GO PUTNXTPKT))
DONE(if (LITATOM FILENAME.or.STREAM)
then (CLOSEF STRM))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T "EOT sent. "))
(during \RFTPpkttimeout.tics timerUnits (QUOTE TICKS) for I from 1
do (if (IGREATERP I 1)
then (if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T
"No response yet to End-Of-Transmission after "
(ITIMES I TWOPKTTIMES.secs)
" seconds." T "EOT being re-sent.")))
(RS232WRITEBYTE MODEMeot T)
repeatuntil (during TWOPKTTIMES.tics timerUnits (QUOTE TICKS)
usingBox (PROG1 \RS232.FTP.BOX
(* Comment PPLossage))
do (SELECTC (SETQ BYTE (RS232READBYTE))
((LIST MODEMack MODEMcan)
(* Ha, found ACK)
(RETURN T))
NIL)))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T (if (EQ BYTE MODEMack)
then "Final ACK received."
else "Never received final ACK.")
" Done!" T))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOPKTTIMES.tics)
(RETURN (LIST FILENAME.or.STREAM))))))
(\RS232FTPCANCEL
(LAMBDA NIL (* JonL " 8-Jan-85 00:42")
(* Called in the resetforms surrounding RS232GETFILE
and RS232PUTFILE)
(PROG ((TWOSECS.tics (UNFOLD \RCLKSECOND 2)))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOSECS.tics)
(RS232WRITEBYTE MODEMcan T)
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOSECS.tics))))
(\RS232FTPPKTFLUSH
(LAMBDA (Delay.tics WatchInterval.tics) (* JonL "21-MAY-83 23:30")
(* Returns non-NIL iff some characters are flushed from the RS232 port; expect to find an interval of time of
Delay.tics during which no characters are coming in.)
(during Delay.tics timerUnits (QUOTE TICKS) usingBox \RS232.THRE.BOX)
(* Just wait for a "delay" amount of time, letting any incoming bytes "fall on the floor" Sending host will wait
for \RFTPpkttimeout.tics amount of time before re-transmitting an unacknowledged packet, which should be an order
of magnitude greater than \RFTPchartimeout.tics)
(if (RS232CLEARBUFFER (QUOTE INPUT))
then (* So be sure that no more are coming in.)
(if (EQ WatchInterval.tics T)
then (until (NULL (RS232READBYTE Delay.tics (QUOTE TICKS))))
elseif (FIXP WatchInterval.tics)
then (during WatchInterval.tics timerUnits (QUOTE TICKS) usingBox \RS232.THRE.BOX
do (if (NULL (RS232READBYTE Delay.tics (QUOTE TICKS)))
then (RETURN))))
(RS232CLEARBUFFER (QUOTE INPUT))
T)))
)
(DEFINEQ
(\RS232FTP.MODEMCOMMAND
(LAMBDA (STR) (* JonL " 3-JAN-83 07:23")
(\RS232FTP.COMMAND STR (QUOTE MODEM))))
(\RS232FTP.DMODEMCOMMAND
(LAMBDA (STR) (* JonL " 3-JAN-83 07:23")
(\RS232FTP.COMMAND STR (QUOTE MODEM))))
(\RS232FTP.8BITCOMMAND
(LAMBDA (STR) (* JonL " 3-JAN-83 07:24")
(\RS232FTP.COMMAND STR (QUOTE 8BIT))))
(\RS232FTP.COMMAND
(LAMBDA (STR PROTOCOL) (* JonL "22-Jun-84 05:12")
(DECLARE (USEDFREE DISPLAYTERMP TIMEOUT.tics))
(PROG (I FILETYPE DIRECTION FILENAME FILENAMELST)
(if (AND (STRINGP STR)
(NEQ 0 (STRINGNCHARS STR)))
then (bind C for old I from (PROG1 1 (* Comment PPLossage))
do (OR (SETQ C (NTHCHARCODE STR I))
(RETURN))
(SELCHARQ C
((B b)
(SETQ FILETYPE (QUOTE BINARY)))
((A a T t)
(SETQ FILETYPE (QUOTE TEXT)))
((S s)
(SETQ DIRECTION (QUOTE PUT)))
((R r)
(SETQ DIRECTION (QUOTE GET)))
((SPACE TAB)
(RETURN))
NIL))
(if (OR (NULL FILETYPE)
(NULL DIRECTION))
then (ERROR "Arguments not complete")
else (until (NOT (MEMB (NTHCHARCODE STR I)
(CHARCODE (SPACE TAB))))
do (add I 1))) (* So I should be the index of the first character of
the file name.)
(SUBSTRING STR I NIL STR)
(SETQ FILENAME (MKATOM STR))
else (PROG NIL
(SETQ FILETYPE (QUOTE TEXT))
B (\RS232EXECSERVER.TERPRI)
(RS232WRITEBYTE (CHARCODE >)
T)
(if (NULL (SETQ I (RS232READBYTE TIMEOUT.tics)))
then (ERROR (QUOTE Time% out))
elseif (EQ I (CHARCODE DEL))
then (RS232WRITESTRING " XXX ")
(ERROR (QUOTE NOERROR)))
(SELCHARQ I
((B b)
(SETQ FILETYPE (QUOTE BINARY))
(RS232WRITESTRING "Binary Mode")
(GO B))
((A a T t)
(SETQ FILETYPE (QUOTE TEXT))
(RS232WRITESTRING "Text Mode")
(GO B))
((S s P p)
(SETQ DIRECTION (QUOTE PUT))
(RS232WRITESTRING (if (FMEMB I (CHARCODE (S s)))
then "Send"
else "Put")))
((R r G g)
(SETQ DIRECTION (QUOTE GET))
(RS232WRITESTRING (if (FMEMB I (CHARCODE (R r)))
then "Receive"
else "Get")))
(PROGN (* Echo his character)
(RS232WRITEBYTE I)
(RS232WRITESTRING " ?")
(GO B)))
(SETQ FILENAME (RS232READ&ECHO.LINE " File = " TIMEOUT.tics DISPLAYTERMP))
(if (OR (NOT (STRINGP FILENAME))
(ZEROP (STRINGNCHARS FILENAME))
(NULL (SETQ FILENAME (CAR (NLSETQ (READ FILENAME)))))
(NOT (LITATOM FILENAME)))
then (SELECTQ FILENAME
(TIMEREXPIRED? (ERROR (QUOTE Time% out)))
((ABORT)
(RS232WRITESTRING " XXX ")
(ERROR (QUOTE NOERROR)))
(RS232WRITESTRING " ?"))
(GO B))))
(if (AND (NOT WHEELP)
(OR (FILENAMEFIELD FILENAME (QUOTE HOST))
(FILENAMEFIELD FILENAME (QUOTE DIRECTORY))))
then (ERROR "Can only FTP from connected directory -- try CONN command "))
(RETURN (SELECTQ DIRECTION
(GET (PROG ((J (NLSETQ (OPENFILE FILENAME (QUOTE OUTPUT)))))
(if J
then (CLOSEF (SETQ FILENAME (CAR J)))
else (ERROR FILENAME "Can't open output file"))
(\RS232EXECSERVER.TERPRI)
(RS232WRITESTRING "Ready to receive into file ")
(RS232WRITESTRING FILENAME T)
(\RS232EXECSERVER.TERPRI)
(RS232GETFILE FILENAME FILETYPE PROTOCOL)))
(PUT (PROG ((J (INFILEP FILENAME)))
(if (NULL J)
then (ERROR FILENAME "File doesn't exist!")
else (\RS232EXECSERVER.TERPRI)
(RS232WRITESTRING "Ready to send file ")
(RS232WRITESTRING J T)
(RS232PUTFILE FILENAME FILETYPE PROTOCOL))))
NIL)))))
)
(ADDTOVAR RS232COMMANDSLST (MODEM \RS232FTP.MODEMCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T)
(MODEMFTP \RS232FTP.MODEMCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T)
(RFTP \RS232FTP.8BITCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T)
(R8FTP \RS232FTP.8BITCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T))
(PUTPROPS RS232FTP COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8290 44899 (\RS232FTPINITIALIZE 8300 . 17631) (RS232GETFILE 17633 . 27321) (
\RS232FTPGETPKT 27323 . 32675) (\RS232FTPGETCHKSM 32677 . 33533) (RS232PUTFILE 33535 . 43141) (
\RS232FTPCANCEL 43143 . 43647) (\RS232FTPPKTFLUSH 43649 . 44897)) (44900 49110 (\RS232FTP.MODEMCOMMAND
44910 . 45077) (\RS232FTP.DMODEMCOMMAND 45079 . 45247) (\RS232FTP.8BITCOMMAND 45249 . 45414) (
\RS232FTP.COMMAND 45416 . 49108)))))
STOP