(FILECREATED "25-MAY-83 22:19:16" {PHYLUM}<LISPCORE>SOURCES>RS232FTP.;73 51082
changes to: (VARS RS232FTPCOMS)
(MACROS GAGALLINTERRUPTS UNGAGINTERRUPTS)
(FNS \RS232FTPINITIALIZE RS232GETFILE)
previous date: "24-MAY-83 12:12:39" {PHYLUM}<LISPCORE>SOURCES>RS232FTP.;71)
(* Copyright (c) 1982, 1983 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)
(MACROS MAKEPKT PKTP PKTBYTE SETPKTBYTE PKTLENGTH SETPKTLENGTH PKTROOM)
(CONSTANTS (MODEMsoh (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
\RS232FTP.WRITENUMBERNIBBLES \RS232FTPCANCEL \RS232FTPPKTFLUSH)
(COMS (FNS \RS232FTP.MODEMCOMMAND \RS232FTP.DMODEMCOMMAND \RS232FTP.8BITCOMMAND
\RS232FTP.7BITCOMMAND \RS232FTP.COMMAND)
(ALISTS (RS232COMMANDSLST MODEM MODEMFTP RFTP R8FTP R7FTP)))))
(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))
)
(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 MODEMsoh (CHARCODE ↑A))
(RPAQ MODEMeot (CHARCODE ↑D))
(RPAQ MODEMack (CHARCODE ↑F))
(RPAQ MODEMnak (CHARCODE ↑U))
(RPAQ MODEMcan (CHARCODE ↑X))
(CONSTANTS (MODEMsoh (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 (BQUOTE (LOGAND (CONSTANT (SUB1 (LLSH 1 , (CAR NBITS))))
, VAL))
else (LOGAND (CAR (CONSTANTEXPRESSIONP VAL))
(SUB1 (LLSH 1 (CAR NBITS)))))
else (BQUOTE (LOGAND (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 ((DISP ACTIVE)
(\PUTBASE \EM.DISPINTERRUPT 0 DISP)
(\PUTBASE (EMADDRESS ACTIVE.EM)
0 ACTIVE)))
)
)
(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 "25-MAY-83 17:05")
(RS232INITIALIZECHECK)
(until (if (NNLITATOM FILENAME.or.STREAM)
then (if (OPENP FILENAME.or.STREAM (QUOTE OUTPUT))
then (SETQ FILENAME.or.STREAM (GETSTREAM FILENAME.or.STREAM (QUOTE OUTPUT)))
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))
(until (SETQ PROTOCOL (SELECTQ PROTOCOL
(MODEM (QUOTE MODEM))
(DMODEM (SETQ EOLProcessing T)
(QUOTE MODEM))
(7BIT (QUOTE 7BIT))
(8BIT (QUOTE 8BIT))
(if (IEQP 7 PROTOCOL)
then (QUOTE 7BIT)
elseif (IEQP 8 PROTOCOL)
then (QUOTE 8BIT))))
do (SETQ PROTOCOL (ERROR "Unrecognized protocol" PROTOCOL)))
(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 BITSPERBYTE
(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 7BIT? (EQ PROTOCOL (QUOTE 7BIT)))
(SETQ 7BITBINARY? (AND 7BIT? (EQ FILETYPE (QUOTE BINARY))))
(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))
(SELECTQ (SYSTEMTYPE)
((D TENEX)
(if (AND (NOT 7BIT?)
(ILESSP (SELECTQ (SYSTEMTYPE)
(D (fetch (RS232CHARACTERISTICS BITSPERCHAR) of RS232INIT))
((TENEX)
(if (STREQUAL "PARC-MAXC" (HOSTNAME))
then 7
else 8))
8)
8))
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 (if 7BIT?
then
(* In PROTOCOL = 7BIT the BLK# byte is split into two nibbles and each nibble sent as one byte;
if FILETYPE = BINARY also, then each data byte is also split. The header byte and two (or four) BLK# bytes are not
counted in the data length.)
(if 7BITBINARY?
then (ITIMES 2 \RFTPpkt.datalength)
else \RFTPpkt.datalength)
else \RFTPpkt.datalength))
(SELECTQ (SYSTEMTYPE)
(D (RS232MODEMCONTROL (QUOTE (DTR RTS))) (* Touch a bunch of things just to be sure that they are
swapped in.)
(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 (LOADTIMECONSTANT (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 \GTREADTABLE1 ALLOCSTRING MKSTRING))
65535))))
(PUT (LOADTIMECONSTANT (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 \GTREADTABLE1 ALLOCSTRING MKSTRING))
65535))))
(SHOULDNT))
(FUNCTION \FRESHENUPFN)))
NIL)
(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 = " (GETFILEINFO STRM (QUOTE LENGTH)
)
" bytes) " T)))))
(RS232GETFILE
(LAMBDA (FILENAME.or.STREAM FILETYPE PROTOCOL REMOTE.COMMAND.STR)
(* JonL "25-MAY-83 18:10")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL))
(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)))
(RESETSAVE NIL (QUOTE (AND RESETSTATE (\RS232FTPCANCEL))))
(PROG ((DOLPHINP (SELECTQ (SYSTEMTYPE)
(D (SERVICEIRING)
(EQ (MACHINETYPE)
(QUOTE DOLPHIN)))
NIL))
(FIRSTPKTP T)
(LASTPKTP)
(SYSPKTP)
(FILELEN 0)
(BLK# 1)
(#NAKS.THIS.PKT -1)
(NAKCAUSE)
7BIT? 7BITBINARY? MODEM? MODEMTEXT? STRM EXPECTED.FILELEN EXPECTED.PKTLEN
EOLProcessing LastWasCR #CHKSMBYTES PKTLEN FIRSTBYTE PKTBLK# PKTBLK#.complement
TWOSECS.tics TWOPKTTIMES.tics TWOPKTTIMES.secs HIGHSPEEDDOLPHINP PKT)
(DECLARE (SPECVARS STRM 7BIT? 7BITBINARY? MODEM? MODEMTEXT? STRM TWOSECS.tics
TWOPKTTIMES.tics TWOPKTTIMES.secs LASTPKTP EXPECTED.PKTLEN
DOLPHINP EOLProcessing LastWasCR))
(\RS232FTPINITIALIZE (QUOTE GET))
(if (AND (PROG1 DOLPHINP (* Comment PPLossage))
(IGREATERP (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT)
\RS232FTPSLOW.BaudRate))
then (SETQ HIGHSPEEDDOLPHINP (LIST (\GETBASE \EM.DISPINTERRUPT 0)
(\GETBASE (EMADDRESS ACTIVE.EM)
0)))
(* (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))))
(KWOTE HIGHSPEEDDOLPHINP)))
(OR (WINDOWP \RS232FTP.FASTMSGW)
(SETQ \RS232FTP.FASTMSGW
((LAMBDA (H) (* H is the Height necessary for 4 lines of text.)
(CREATEW (create REGION
LEFT ← 10
BOTTOM ←(IDIFFERENCE SCREENHEIGHT H)
WIDTH ←(IDIFFERENCE SCREENWIDTH 20)
HEIGHT ← H)
NIL 0))
(TIMES 4 (IABS (DSPLINEFEED NIL WindowTitleDisplayStream))))))
(RESETSAVE (SETDISPLAYHEIGHT (fetch HEIGHT of (WINDOWPROP
\RS232FTP.FASTMSGW
(QUOTE REGION))
)))
(if (AND (PROG1 RS232FTPTRACFILE
(* Comment PPLossage))
(DISPLAYSTREAMP (ffetch (STREAMOFDISPLAYSTREAM DISPLAYSTREAM)
(GETSTREAM RS232FTPTRACFILE
(QUOTE OUTPUT)))))
then (RESETSAVE RS232FTPTRACFILE \RS232FTP.FASTMSGW))
(DSPRESET \RS232FTP.FASTMSGW)
((LAMBDA (Y)
(DSPXPOSITION (IQUOTIENT (fetch WIDTH of (WINDOWPROP
\RS232FTP.FASTMSGW
(QUOTE REGION)))
2)
\RS232FTP.FASTMSGW)
(PRIN1 "Trimming Display to achieve high speed for Dolphin"
\RS232FTP.FASTMSGW)
(MOVETO 0 Y \RS232FTP.FASTMSGW))
(DSPYPOSITION NIL \RS232FTP.FASTMSGW)))
(if REMOTE.COMMAND.STR
then (RS232WRITECHARS (OR (STRINGP REMOTE.COMMAND.STR)
(MKSTRING REMOTE.COMMAND.STR)))
(RS232WRITEBYTE (CHARCODE EOL)
T)) (* We count the checksum bytes on the GET side.
Note that in 7BIT mode, the checksum is delivered in
nibbles.)
(SETQ #CHKSMBYTES (if MODEM?
then 1
elseif 7BIT?
then 4
else 2))
(* 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.)
NAK (SETQ LASTPKTP (SETQ EOLProcessing)) (* If we have to NAK on the last packet, then don't be
misled.)
(if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS (CAR HIGHSPEEDDOLPHINP)
(CADR HIGHSPEEDDOLPHINP)))
(if (ILESSP 10 (add #NAKS.THIS.PKT 1))
then (RETURN "Packet receipt failed after 10 tries."))
(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)))
(\RS232CHECK.BLOCK)
(\RS232FTPPKTFLUSH TWOPKTTIMES.tics T)
GETNXTPKT
(for CNT to 10
do (PROGN (if HIGHSPEEDDOLPHINP
then (GAGALLINTERRUPTS))
(RS232WRITEBYTE MODEMnak T))
(during \RFTPpkttimeout.tics timerUnits (QUOTE TICKS) usingTimer
(PROG1
\RS232.FTP.BOX
(* Comment PPLossage))
do (SELECTC (SETQ FIRSTBYTE (RS232READBYTE))
(MODEMsoh (if LASTPKTP
then (SETQ NAKCAUSE
"EOT expected, but SOH received")
(GO NAK)
else (SETQ SYSPKTP)
(GO GETBLK#)))
(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 (CAR HIGHSPEEDDOLPHINP)
(CADR HIGHSPEEDDOLPHINP))
20))
(if (EQ RS232FTPTRACEFLG (QUOTE PEEK))
then (PRIN1 (QUOTE %.)
RS232FTPTRACEFILE)
elseif RS232FTPTRACEFLG
then (printout RS232FTPTRACEFILE T "Re-NAKing 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#
(OR (AND (SETQ PKTBLK# (RS232READBYTE \RFTPchartimeout.tics (QUOTE TICKS)))
(SETQ PKTBLK#.complement (RS232READBYTE \RFTPchartimeout.tics
(QUOTE TICKS))))
(PROGN (SETQ NAKCAUSE "Timed out on packet BLK# bytes")
(GO NAK)))
(if 7BIT?
then (PROG (NIBBLE1 NIBBLE2)
(SETQ PKTBLK# (BYTEFROM2NIBBLES PKTBLK# PKTBLK#.complement))
(OR (AND (SETQ NIBBLE1 (RS232READBYTE \RFTPchartimeout.tics
(QUOTE TICKS)))
(SETQ NIBBLE2 (RS232READBYTE \RFTPchartimeout.tics
(QUOTE TICKS))))
(PROGN (SETQ NAKCAUSE
"Didn't get PKT BLK# bytes (extra for 7BIT)")
(GO NAK)))
(SETQ PKTBLK#.complement (BYTEFROM2NIBBLES NIBBLE1 NIBBLE2))))
(if (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&BIC2.tics TWOPKTTIMES.tics)
(GO ACK))
(SETQ PKT (\RS232FTPGETPKT (if SYSPKTP
then \RFTPsyspkt.datalength
elseif (AND FIRSTPKTP (NOT MODEM?))
then 3
else EXPECTED.PKTLEN)
#CHKSMBYTES MODEM? MODEMTEXT? 7BITBINARY?
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&BIC8.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)) (* Remember, LASTPKTP is 0-origined)
(SETPKTLENGTH PKT LASTPKTP))
(if HIGHSPEEDDOLPHINP
then (UNGAGINTERRUPTS (CAR HIGHSPEEDDOLPHINP)
(CADR 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 FIRSTPKTP
then (* In non-MODEM 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 (ILESSP (add EXPECTED.FILELEN (IMINUS PKTLEN))
\RFTPpkt.datalength)
then (* Adjusted expected packet lenght for the last packet
on a non-MODEM transfer)
(if (ILEQ EXPECTED.FILELEN 0)
then (SETQ LASTPKTP T)
else (PROG ((DELTA (IDIFFERENCE EXPECTED.FILELEN \RFTPpkt.datalength)))
(add EXPECTED.PKTLEN DELTA)
(if 7BITBINARY?
then (* But remember, 7-bit binary mode has double the number
of data bytes.)
(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)
ACK (SETQ #NAKS.THIS.PKT 0)
(if (AND RS232FTPTRACEFLG (NEQ RS232FTPTRACEFLG (QUOTE PEEK)))
then (printout RS232FTPTRACEFILE T "ACKing block number " PKTBLK#))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC2.tics TWOPKTTIMES.tics)
(\RS232CHECK.BLOCK (AND HIGHSPEEDDOLPHINP 20))
(SETQ FIRSTPKTP)
(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 (CAR HIGHSPEEDDOLPHINP)
(CADR HIGHSPEEDDOLPHINP)))
(if (LITATOM FILENAME.or.STREAM)
then (CLOSEF STRM))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC8.tics TWOPKTTIMES.tics)
(RETURN FILELEN)))))
(\RS232FTPGETPKT
(LAMBDA (#BYTES #CHKSMBYTES MODEM? MODEMTEXT? 7BITBINARY? EOLProcessing ILASTWASCR)
(DECLARE (SPECVARS 7BIT? 7BITBINARY? MODEM? MODEMTEXT? LASTPKTP DOLPHINP EOLProcessing))
(* JonL "21-MAY-83 23:38")
(* 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)
(freplace (STRINGP BASE) of \RS232PKTSTRPTR with (ffetch (STRINGP BASE)
of \RS232PKTBUFFER))
(freplace (STRINGP OFFST) of \RS232PKTSTRPTR with 0)
(* Note: several places depend upon this OFFST being 0)
(freplace (STRINGP LENGTH) of \RS232PKTSTRPTR
with (OR (FIXP #BYTES)
(IPLUS (STRINGNCHARS \RS232PKTBUFFER)
(ffetch (STRINGP OFFST) of \RS232PKTBUFFER))))
(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 \RS232.READAFEWBYTES 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))
(if (NOT 7BITBINARY?)
then (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 (if (ODDP PKTLEN)
then (RETURN (LIST "Odd number databytes in 7-bit binary PKT = " PKTLEN)
))
((LAMBDA (BASE OFFST) (* Pack in the nibbles two for one, and also calculate
the check sum.)
(for I from OFFST by 2 to (IPLUS PKTLEN OFFST -1) as J from OFFST
do (\PUTBASEBYTE BASE J (BYTEFROM2NIBBLES (\GETBASEBYTE BASE I)
(\GETBASEBYTE
BASE
(ADD1 I))))
(add STRSM C)))
(ffetch (STRINGP BASE) of PKT)
(ffetch (STRINGP OFFST) of PKT))
(SETPKTLENGTH PKT (SETQ PKTLEN (LRSH PKTLEN 1))))
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 (if 7BITBINARY?
then (LRSH #BYTES 1)
else #BYTES))
do (OR (SETQ C (RS232READBYTE \RFTPchartimeout.tics (QUOTE TICKS)))
(GO SHORTPKTP))
(add PKTLEN 1)
(if 7BITBINARY?
then (* Pack two nibbles into one byte in the 7BITBINARY?
mode)
(SETQ C (BYTEFROM2NIBBLES C (OR (RS232READBYTE \RFTPchartimeout.tics
(QUOTE TICKS))
(GO SHORTPKTP))))
(add PKTLEN 1)
elseif (NOT MODEMTEXT?)
then NIL
else (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 (if 7BITBINARY?
then (SETQ PKTLEN (LRSH PKTLEN 1))
else 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 MODEM?
then (TRIMTOBITS BITSPERBYTE STRSM)
else (TRIMTOBITS BITSPERWORD 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 "21-MAY-83 23:28")
(DECLARE (SPECVARS FILENAME.or.STREAM FILETYPE PROTOCOL))
(RESETLST (SELECTQ (SYSTEMTYPE)
(D (RESETSAVE RS232XON\XOFF? XON\XOFF?))
(RESETSAVE (INTERRUPTABLE NIL)))
(RESETSAVE NIL (QUOTE (AND RESETSTATE (\RS232FTPCANCEL))))
(PROG ((BLK# 1)
(FIRSTPKTP T)
(#RESENDS.THIS.PKT -1)
(NAKCAUSE)
(10SECS.tics (ITIMES 10 \RCLKSECOND))
TWOSECS.tics TWOPKTTIMES.tics TWOPKTTIMES.secs 7BIT? 7BITBINARY? MODEM?
MODEMTEXT? STRM FILELEN EXPECTED.PKTLEN PKTLEN PKTBLK# PKTBLK#.complement BYTE
CHKSM EOLProcessing #LOSTLFS)
(DECLARE (SPECVARS STRM 7BIT? 7BITBINARY? MODEM? MODEMTEXT? STRM TWOSECS.tics
TWOPKTTIMES.tics TWOPKTTIMES.secs LASTPKTP EXPECTED.PKTLEN
DOLPHINP EOLProcessing))
(\RS232FTPINITIALIZE (QUOTE PUT))
(SETQ FILELEN (GETFILEINFO (SELECTQ (SYSTEMTYPE)
(D STRM)
FILENAME.or.STREAM)
(QUOTE LENGTH)))
(if REMOTE.COMMAND.STR
then (RS232WRITECHARS (MKSTRING REMOTE.COMMAND.STR))
(* 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))
(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&BIC8.tics TWOPKTTIMES.tics)
PUTNXTPKT (* Prepare the data in a buffer first, before sending
out MODEMsoh)
(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 BITSPERWORD CHKSM))))
(RS232WRITEBYTE MODEMsoh T)
PUTBLK#
(SETQ PKTBLK#.complement (TRIMTOBITS BITSPERBYTE (LOGXOR -1 BLK#)))
(if 7BIT?
then (RS232WRITEBYTE (LRSH BLK# BITSPERNIBBLE))
(RS232WRITEBYTE (TRIMTOBITS BITSPERNIBBLE BLK#))
(RS232WRITEBYTE (LRSH PKTBLK#.complement BITSPERNIBBLE))
(RS232WRITEBYTE (TRIMTOBITS BITSPERNIBBLE PKTBLK#.complement))
else (RS232WRITEBYTE BLK#)
(RS232WRITEBYTE PKTBLK#.complement))
PUTPKTDATA
(RS232FORCEOUTPUT)
(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 (SERVICEIRING)
(if (NULL RS232XOFF?)
then (RETURN))
finally (GO RETRANSMIT)))
(RS232WRITEBYTE (PKTBYTE \RS232PKTBUFFER I)
T T))
PUTCHKSM
(if MODEM?
then (RS232WRITEBYTE CHKSM T)
elseif 7BIT?
then (\RS232FTP.WRITENUMBERNIBBLES CHKSM 4)
(RS232FORCEOUTPUT)
else (RS232WRITEBYTE (fetch (WORD HIBYTE) of CHKSM))
(RS232WRITEBYTE (fetch (WORD LOBYTE) of 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))))
(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))
(MODEMack
(* Ha, found ACK)
(RETURN T))
(MODEMcan
(* Foo)
(HELP
"System packets not yet implemented"))
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&BIC8.tics TWOPKTTIMES.tics)
(RETURN (LIST FILENAME.or.STREAM))))))
(\RS232FTP.WRITENUMBERNIBBLES
(LAMBDA (BYTE N) (* JonL " 5-JAN-83 23:08")
(if (IGREATERP N 1)
then (\RS232FTP.WRITENUMBERNIBBLES (LRSH BYTE BITSPERNIBBLE)
(SUB1 N)))
(RS232WRITEBYTE (TRIMTOBITS BITSPERNIBBLE BYTE))))
(\RS232FTPCANCEL
(LAMBDA NIL (* JonL "21-MAY-83 23:29")
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC8.tics TWOSECS.tics)
(RS232WRITEBYTE MODEMcan T)
(if (LITATOM \RS232FTP.FILENAME)
then (CLOSEF? \RS232FTP.FILENAME))
(\RS232FTPPKTFLUSH \RS232.Tovh&BIC8.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.7BITCOMMAND
(LAMBDA (STR) (* JonL " 3-JAN-83 07:24")
(\RS232FTP.COMMAND STR (QUOTE 7BIT))))
(\RS232FTP.COMMAND
(LAMBDA (STR PROTOCOL) (* JonL " 7-MAY-83 22:25")
(PROG (I FILETYPE DIRECTION FILENAME)
(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 ((TIMEOUT.tics (LOADTIMECONSTANT (ITIMES 3 60 \RCLKSECOND))))
(SETQ FILETYPE (QUOTE TEXT))
B (\RS232COMMANDSERVER.TERPRI)
(RS232WRITEBYTE (CHARCODE >)
T)
(OR (SETQ I (RS232READBYTE TIMEOUT.tics))
(ERROR "3-minute timeout"))
(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 = "))
(if (OR (NOT (STRINGP FILENAME))
(ZEROP (NCHARS FILENAME))
(NULL (SETQ FILENAME (CAR (NLSETQ (READ FILENAME)))))
(NOT (LITATOM FILENAME)))
then (RS232WRITECHARS " ?")
(GO B))))
(RETURN (SELECTQ DIRECTION
(GET (PROG ((J (NLSETQ (OPENFILE FILENAME (QUOTE OUTPUT)))))
(if J
then (CLOSEF (SETQ FILENAME (CAR J)))
else (ERROR "Can't open output file"))
(\RS232COMMANDSERVER.TERPRI)
(RS232WRITECHARS "Ready to receive into file ")
(RS232WRITECHARS FILENAME T)
(RS232GETFILE FILENAME FILETYPE PROTOCOL)))
(PUT (PROG ((J (INFILEP FILENAME))
(FNFMSG "File doesn't exist!"))
(if (NULL J)
then (\RS232COMMANDSERVER.TERPRI)
(RS232WRITECHARS FNFMSG)
(\RS232COMMANDSERVER.TERPRI)
(ERROR FNFMSG)
else (\RS232COMMANDSERVER.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})
(RFTP \RS232FTP.8BITCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T)
(R8FTP \RS232FTP.8BITCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T)
(R7FTP \RS232FTP.7BITCOMMAND
{Send% or% Receive}{Ascii% or% Binary}% {filename} T))
(PUTPROPS RS232FTP COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7318 46570 (\RS232FTPINITIALIZE 7328 . 13898) (RS232GETFILE 13900 . 27100) (
\RS232FTPGETPKT 27102 . 33785) (\RS232FTPGETCHKSM 33787 . 34643) (RS232PUTFILE 34645 . 44664) (
\RS232FTP.WRITENUMBERNIBBLES 44666 . 44963) (\RS232FTPCANCEL 44965 . 45318) (\RS232FTPPKTFLUSH 45320
. 46568)) (46571 50487 (\RS232FTP.MODEMCOMMAND 46581 . 46748) (\RS232FTP.DMODEMCOMMAND 46750 . 46918)
(\RS232FTP.8BITCOMMAND 46920 . 47085) (\RS232FTP.7BITCOMMAND 47087 . 47252) (\RS232FTP.COMMAND 47254
. 50485)))))
STOP