(FILECREATED "14-Mar-84 04:39:19" {PHYLUM}<LISP>LIBRARY>RS232FTP.;9 49556
changes to: (FNS \RS232FTPINITIALIZE)
previous date: "12-Mar-84 16:46:21" {PHYLUM}<LISP>LIBRARY>RS232FTP.;8)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(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 . T)
)
(* MODEM ftp protocols)
(DECLARE: DONTCOPY
(* Random macros which distinguish between I-10 and I-D (and I-VAX ?))
(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))
)
(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)))
)
(* Other random MACROS)
(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
(ADDTOVAR 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 "14-Mar-84 04:37")
(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 (SELECTQ (SYSTEMTYPE)
(D (AND (type? STREAM FILENAME.or.STREAM)
(WRITEABLE FILENAME.or.STREAM)
(EQ BITSPERBYTE (fetch (STREAM BYTESIZE) of FILENAME.or.STREAM))))
((TENEX TOPS20)
(AND (FIXP FILENAME.or.STREAM)
(JFNS FILENAME.or.STREAM)))
NIL))
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))))
(SELECTQ (SYSTEMTYPE)
(D (CAR (NLSETQ (AND (NOT (LITATOM FILENAME.or.STREAM))
(GETFILEINFO FILENAME.or.STREAM (QUOTE TYPE))))))
NIL))
(bind TEM until (SETQ TEM (SELECTQ PROTOCOL
(MODEM (QUOTE MODEM))
(DMODEM (SETQ EOLProcessing T)
(QUOTE MODEM))
(8BIT (QUOTE 8BIT))
(if (IEQP 8 PROTOCOL)
then (QUOTE 8BIT))))
do (SETQ PROTOCOL (ERROR "Unrecognized protocol" PROTOCOL)) finally (SETQ PROTOCOL TEM))
(RESETSAVE NIL (QUOTE (AND RESETSTATE (\RS232FTPCANCEL))))
(SETQ STRM (if (LITATOM FILENAME.or.STREAM)
then (SETQ \RS232FTP.FILENAME (OPENFILE FILENAME.or.STREAM
(SELECTQ OPERATION
(GET (QUOTE OUTPUT))
(PUT (QUOTE INPUT))
(SHOULDNT))
NIL
(SELECTQ (SYSTEMTYPE)
(D BITSPERBYTE)
((TENEX TOPS20)
(SELECTQ FILETYPE
(TEXT 7)
(BINARY 8)
(SHOULDNT)))
8)
(LIST (LIST (QUOTE TYPE)
FILETYPE))))
(GETSTREAM \RS232FTP.FILENAME)
else (SETQ \RS232FTP.FILENAME)
FILENAME.or.STREAM))
(if (OR (NOT (PKTP \RS232PKTBUFFER))
(NOT (ILEQ \RS232PKTBUFFER.SIZE (PKTROOM \RS232PKTBUFFER))))
then (SETQ \RS232PKTBUFFER (MAKEPKT \RS232PKTBUFFER.SIZE)))
(SETQ DOLPHINP (SELECTQ (SYSTEMTYPE)
(D (\RS232.CHECKUART)
(EQ (MACHINETYPE)
(QUOTE DOLPHIN)))
NIL))
(SETQ MODEM? (EQ PROTOCOL (QUOTE MODEM)))
(SETQ MODEMTEXT? (AND MODEM? (EQ FILETYPE (QUOTE TEXT))))
(SETQ TWOSECS.tics (ITIMES 2 \RCLKSECOND))
(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))
(SELECTQ (SYSTEMTYPE)
((D TENEX)
(if (SELECTQ (SYSTEMTYPE)
(D (ILESSP (fetch (RS232CHARACTERISTICS BITSPERCHAR) of RS232INIT)
8))
NIL)
then (* Lose, if we as for 8-bit mode on a host/UART that is
doing 7bit.)
(ERROR "Wrong # bits per serial char for this protocol." PROTOCOL)))
NIL)
(SETQ EXPECTED.PKTLEN \RFTPpkt.datalength)
(if (EQ OPERATION (QUOTE PUT))
then (SETQ FILELEN (GETFILEINFO (SELECTQ (SYSTEMTYPE)
(D STRM)
FILENAME.or.STREAM)
(QUOTE LENGTH))))
(if RS232FTPTRACEFLG
then (printout RS232FTPTRACEFILE T OPERATION " (" (L-CASE FILETYPE)
(SELECTQ OPERATION
(GET ") to ")
") from ")
(SELECTQ (SYSTEMTYPE)
(D (FULLNAME STRM))
(if (LITATOM FILENAME.or.STREAM)
then (FULLNAME FILENAME.or.STREAM)
else (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(AND (FIXP FILENAME.or.STREAM)
(JFNS FILENAME.or.STREAM)))
NIL)))
", 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.)
(SELECTQ (SYSTEMTYPE)
(D (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)))
NIL)
(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 " 2-Dec-83 21:31")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR))
(SETQ \RS232FTP.FILENAME (AND (LITATOM FILENAME.or.STREAM)
FILENAME.or.STREAM)) (* This will be set up by \RS232FTPINITIALIZE but want a
reasonable value before doing the RESETSAVE)
(RESETLST (SELECTQ (SYSTEMTYPE)
(D (RESETSAVE RS232XON\XOFF? NIL))
(RESETSAVE (INTERRUPTABLE NIL)))
(PROG ((FIRSTPKTP T)
(LASTPKTP)
(SYSPKTP)
(FILELEN 0)
(BLK# 1)
(#NAKS.THIS.PKT -1)
(NAKCAUSE)
DOLPHINP MODEM? MODEMTEXT? 8BIT? KERMIT? STRM EXPECTED.FILELEN EXPECTED.PKTLEN
EOLProcessing LastWasCR #CHKSMBYTES PKTLEN FIRSTBYTE PKTBLK# PKTBLK#.complement
TWOSECS.tics TWOPKTTIMES.tics TWOPKTTIMES.secs HIGHSPEEDDOLPHINP PKT PROMPTBYTE)
(DECLARE (SPECVARS STRM MODEM? MODEMTEXT? 8BIT? KERMIT? TWOSECS.tics
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
elseif 8BIT?
then 2
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)
elseif (AND 8BIT? FIRSTPKTP)
then (* In 8BIT protocols, the first packet transmits the
file length, in 8-bit bytes, as 3 7-bit digits.)
(SETQ EXPECTED.FILELEN (LOGOR (LRSH (LLSH (PKTBYTE PKT 0)
16)
2)
(LRSH (LLSH (PKTBYTE PKT 1)
8)
1)
(PKTBYTE PKT 2)))
(GO ACK))
(SETQ BLK# (TRIMTOBITS BITSPERBYTE (ADD1 BLK#)))
(SETQ PKTLEN (PKTLENGTH PKT))
(if MODEM?
then (* We don't count the file length exactly in the MODEM
protocol.)
NIL
elseif KERMIT?
then NIL
elseif (AND 8BIT? (ILESSP (add EXPECTED.FILELEN (IMINUS PKTLEN))
\RFTPpkt.datalength))
then (* Adjusted expected packet lenght for the last packet
on an 8-bit transfer)
(if (ILEQ EXPECTED.FILELEN 0)
then (SETQ LASTPKTP T)
else (PROG ((DELTA (IDIFFERENCE EXPECTED.FILELEN \RFTPpkt.datalength)))
(add EXPECTED.PKTLEN DELTA)
(if (ILESSP EXPECTED.PKTLEN 2)
then (SHOULDNT
"Expected FILELEN caused negative pkt length")))))
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout T "; and writing it to file."))
(SELECTQ (SYSTEMTYPE)
(D (\BOUTS STRM (ffetch (STRINGP BASE) of PKT)
0 PKTLEN))
(for I from 0 to (SUB1 PKTLEN) do (BOUT STRM (PKTBYTE PKT I))))
(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? 8BIT? KERMIT? LASTPKTP DOLPHINP EOLProcessing))
(* JonL "15-OCT-83 02:18")
(* 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))
(SELECTQ (SYSTEMTYPE)
(D (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))
(PROGN (SETQ PKT \RS232PKTBUFFER)
(SETPKTLENGTH PKT (PKTROOM PKT))))
(if (SELECTQ (SYSTEMTYPE)
(D (if DOLPHINP
then (PROG1 (ILESSP \RS232FTPSLOW.BaudRate (fetch (RS232CHARACTERISTICS
BAUDRATE)
of RS232INIT))
(SERVICEIRING))))
NIL)
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))
(SELECTQ (SYSTEMTYPE)
(D (AND DOLPHINP (SERVICEIRING)))
NIL)
(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 (if 8BIT?
then (TRIMTOBITS (CONSTANT (TIMES 2 BITSPERBYTE))
STRSM)
else (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 " 2-Dec-83 21:32")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR))
(RESETLST (SELECTQ (SYSTEMTYPE)
(D (RESETSAVE RS232XON\XOFF? XON\XOFF?))
(RESETSAVE (INTERRUPTABLE NIL)))
(PROG ((BLK# 1)
(FIRSTPKTP T)
(#RESENDS.THIS.PKT -1)
(NAKCAUSE)
(10SECS.tics (ITIMES 10 \RCLKSECOND))
TWOSECS.tics 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? TWOSECS.tics 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 (SELECTQ (SYSTEMTYPE)
(D (NOT EOLProcessing))
NIL)
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 (SELECTQ (SYSTEMTYPE)
(D (NULL RS232XON\XOFF?))
NIL)
then (\RS232WRITEBASEBYTES NIL (fetch (STRINGP BASE) of \RS232PKTBUFFER)
(fetch (STRINGP OFFST) of \RS232PKTBUFFER)
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 (\RS232.CHECKUART)
(if (NULL RS232XOFF?)
then (RETURN))
finally (GO RETRANSMIT)))
(RS232WRITEBYTE (PKTBYTE \RS232PKTBUFFER I)
T T)))
PUTCHKSM
(if MODEM?
then (RS232WRITEBYTE CHKSM T)
elseif 8BIT?
then (RS232WRITEBYTE (LRSH CHKSM BITSPERBYTE))
(RS232WRITEBYTE (TRIMTOBITS BITSPERBYTE CHKSM)
T))
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 " 2-Dec-83 21:32")
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC16.tics TWOSECS.tics)
(RS232WRITEBYTE MODEMcan T)
(if (LITATOM \RS232FTP.FILENAME)
then (CLOSEF? \RS232FTP.FILENAME))
(\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 " 1-Dec-83 01:02")
(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))
(RS232WRITECHARS "Binary Mode")
(GO B))
((A a T t)
(SETQ FILETYPE (QUOTE TEXT))
(RS232WRITECHARS "Text Mode")
(GO B))
((S s P p)
(SETQ DIRECTION (QUOTE PUT))
(RS232WRITECHARS (if (FMEMB I (CHARCODE (S s)))
then "Send"
else "Put")))
((R r G g)
(SETQ DIRECTION (QUOTE GET))
(RS232WRITECHARS (if (FMEMB I (CHARCODE (R r)))
then "Receive"
else "Get")))
(PROGN (* Echo his character)
(RS232WRITEBYTE I)
(RS232WRITECHARS " ?")
(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)))
(RS232WRITECHARS " ?"))
(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)
(RS232WRITECHARS "Ready to receive into file ")
(RS232WRITECHARS 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)
(RS232WRITECHARS "Ready to send file ")
(RS232WRITECHARS 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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7616 44853 (\RS232FTPINITIALIZE 7626 . 16929) (RS232GETFILE 16931 . 27606) (
\RS232FTPGETPKT 27608 . 32986) (\RS232FTPGETCHKSM 32988 . 33844) (RS232PUTFILE 33846 . 43244) (
\RS232FTPCANCEL 43246 . 43601) (\RS232FTPPKTFLUSH 43603 . 44851)) (44854 49050 (\RS232FTP.MODEMCOMMAND
44864 . 45031) (\RS232FTP.DMODEMCOMMAND 45033 . 45201) (\RS232FTP.8BITCOMMAND 45203 . 45368) (
\RS232FTP.COMMAND 45370 . 49048)))))
STOP