(FILECREATED "20-Feb-85 09:19:46" {PHYLUM}<LFG>PARSER>FILLBUFFERPATCH.;2 11023
changes to: (FNS \FILLBUFFER)
previous date: "13-Feb-85 22:20:40" {PHYLUM}<LFG>PARSER>FILLBUFFERPATCH.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILLBUFFERPATCHCOMS)
(RPAQQ FILLBUFFERPATCHCOMS ((FNS \FILLBUFFER)))
(DEFINEQ
(\FILLBUFFER
[LAMBDA (FILLTYPE) (* rmk: "20-Feb-85 08:52")
(* While filling the line, the current file pointer is the end of the line. When the line is closed, this is made
the eof. -
#CURRENTRDTBL# is used for syntactic delimiters and paren counting on READ and RATOM calls but isn't referenced
(or bound) for READC)
(DECLARE (USEDFREE #CURRENTRDTBL# FLG))
(\RESETLINE)
(PROG ((ILB (fetch (LINEBUFFER LBRKCOUNT) of \LINEBUF.OFD))
(ISP (fetch (LINEBUFFER INSTRINGP) of \LINEBUF.OFD))
(ILP (fetch (LINEBUFFER LPARCOUNT) of \LINEBUF.OFD))
(RTBLSA (AND (NEQ FILLTYPE READC.FT)
(fetch READSA of #CURRENTRDTBL#)))
(CONTROLTON (fetch CONTROLFLG of \PRIMTERMTABLE))
RSNX TCLASS C RAISEDCHAR PEEKEDECHOED) (* TCLASS is terminal syntax class, RSNX is read-table
code)
[COND
((SETQ C (fetch (LINEBUFFER PEEKEDCHAR) of \LINEBUF.OFD))
(* Account for peeked character)
(COND
((AND NIL (NULL (fetch (LINEBUFFER PEEKEDECHOFLG) of \LINEBUF.OFD)))
(* It wasn't echoed when first read, so echo it now if
desired)
(* Incompatible with I-10 to do it this way)
(\ECHOCHAR C)))
(replace (LINEBUFFER PEEKEDCHAR) of \LINEBUF.OFD with NIL)
(SETQ PEEKEDECHOED T)
(SETQ RAISEDCHAR (\RAISECHAR C]
(COND
((AND CONTROLTON (EQ FILLTYPE READC.FT))
(\BOUT \LINEBUF.OFD (OR C (\GETCHAR)))
(GO EXIT)))
(COND
(C (GO NEXTTCLASS)))
NEXT(SETQ C (\GETKEY))
NEXTTCLASS
[SETQ TCLASS (fetch TERMCLASS of (\SYNCODE \PRIMTERMSA (SETQ RAISEDCHAR (\RAISECHAR C]
REDO(SELECTC TCLASS
(RETYPE.TC (\BOUT \TERM.OFD (CHARCODE EOL))
(\SETEOFPTR \LINEBUF.OFD (\GETFILEPTR \LINEBUF.OFD))
(* Make the EOF be accurate during retyping, in case an
interrupt happens and the buffer gets saved via
\SAVELINEBUF.)
(UNINTERRUPTABLY
(\SETFILEPTR \LINEBUF.OFD 0)
(replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with
RETYPING.LBS))
(until (\EOFP \LINEBUF.OFD) do (\BOUT \TERM.OFD (\BIN \LINEBUF.OFD)))
(replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with FILLING.LBS)
(GO NEXT))
(LINEDELETE.TC (DSPSOUT (fetch LINEDELETE of \PRIMTERMTABLE))
(UNINTERRUPTABLY
(replace (LINEBUFFER LPARCOUNT) of \LINEBUF.OFD with ILP)
(* Eventually, should back up 1 char at a time, erasing
and doing \DECPARENCOUNT. Then the I* variables won't
be needed.)
(replace (LINEBUFFER LBRKCOUNT) of \LINEBUF.OFD with ILB)
(replace (LINEBUFFER INSTRINGP) of \LINEBUF.OFD with ISP)
(\SETFILEPTR \LINEBUF.OFD 0)
(\SETEOFPTR \LINEBUF.OFD 0)
(GO NEXT)))
((LIST CHARDELETE.TC WORDDELETE.TC)
(COND
((NULL (SETQ C (\CHDEL1)))
(DSPSOUT (fetch EMPTYCHDEL of \PRIMTERMTABLE))
(GO NEXT)))
(DSPSOUT (fetch 1STCHDEL of \PRIMTERMTABLE))
[PROG (C1 (DELECHO (EQ (fetch DELCHARECHO of \PRIMTERMTABLE)
(QUOTE ECHO)))
(NTH (fetch NTHCHDEL of \PRIMTERMTABLE))
(ESCAPE? (AND (NEQ FILLTYPE READC.FT)
(fetch ESCAPEFLG of #CURRENTRDTBL#)
ESCAPE.RC)))
(GO FIRST)
AGAIN
(COND
((NULL (SETQ C (\CHDEL1)))
(DSPSOUT (fetch EMPTYCHDEL of \PRIMTERMTABLE))
(GO NEXT)))
(DSPSOUT NTH)
FIRST
(AND DELECHO (\ECHOCHAR C)) (* Delete 2nd thru Nth)
[COND
((NEQ FILLTYPE READC.FT) (* Don't process escapes if READC)
(SETQ RSNX (\SYNCODE RTBLSA C))
[COND
((SETQ C1 (\CHDEL1)) (* Check preceding char C1 for escape)
(COND
((EQ ESCAPE? (\SYNCODE RTBLSA C1))
(DSPSOUT NTH)
(AND DELECHO (\ECHOCHAR C1))
(SETQ RSNX OTHER.RC))
(T (* Put the non-escape back in the buffer)
(\BOUT \LINEBUF.OFD C1]
(\DECPARENCOUNT RSNX)
(COND
((EQ TCLASS WORDDELETE.TC)
(* Cycle back until first non-sepr/non-other, or first non-other after sepr string and other string.
Note that a terminal wordsepr is treated as if it were a read-sepr)
(SELECTC RSNX
(SEPRCHAR.RC (OR (ZEROP (\GETFILEPTR \LINEBUF.OFD))
(GO AGAIN)))
(OTHER.RC [COND
((EQ WORDSEPR.TC (\SYNCODE \PRIMTERMSA C))
(OR (ZEROP (\GETFILEPTR \LINEBUF.OFD))
(GO AGAIN]
(PROG NIL
(* The first OTHER)
TRY (COND
((NULL (SETQ C (\CHDEL1)))
(RETURN)))
(SETQ RSNX (\SYNCODE RTBLSA C))
(SETQ TCLASS (\SYNCODE \PRIMTERMSA C))
CHK [COND
((AND (NEQ TCLASS WORDSEPR.TC)
(OR (EQ OTHER.RC RSNX)
(EQ ESCAPE? RSNX)))
(* Erase it)
(DSPSOUT NTH)
(AND DELECHO (\ECHOCHAR C))
(GO TRY))
((SETQ C1 (\CHDEL1))
(\BOUT \LINEBUF.OFD C1)
(* Put it back)
(COND
((EQ ESCAPE? (\SYNCODE RTBLSA C1))
(SETQ RSNX OTHER.RC)
(SETQ TCLASS NONE.TC)
(GO CHK]
(\BOUT \LINEBUF.OFD C)))
NIL]
(* Use \GETKEY for next character to suppress echoing in case we have to print the post message first.
If it's a real character, we echo it and raise it)
(SETQ C (\GETKEY))
(SELECTC [SETQ TCLASS (fetch TERMCLASS of (\SYNCODE \PRIMTERMSA
(SETQ RAISEDCHAR
(\RAISECHAR C]
((LIST CHARDELETE.TC WORDDELETE.TC)
(GO AGAIN))
((LIST LINEDELETE.TC RETYPE.TC))
(DSPSOUT (fetch POSTCHDEL of \PRIMTERMTABLE]
(GO REDO))
(CTRLV.TC
(* The reasonable thing to do is coerce the character, set TCLASS to NONE.TC, and go REDO. But on the 10, ctlv
disables the immediacy of read-macros. This is quite bizarre, cause a macro that was suppose to do something in the
middle of reading will be done out of context. We simulate that behavior, however.)
(\ECHOCHAR C) (* Want to echo ↑V)
(\BOUT \LINEBUF.OFD (COND
([OR (AND (IGEQ (SETQ RAISEDCHAR (\GETCHAR))
(CHARCODE A))
(ILEQ RAISEDCHAR (CHARCODE Z)))
(AND (IGEQ RAISEDCHAR (CHARCODE a))
(ILEQ RAISEDCHAR (CHARCODE z]
(LOGAND RAISEDCHAR 31))
(T RAISEDCHAR)))
(GO NEXT))
(EOL.TC (\ECHOCHAR C)
(\BOUT \LINEBUF.OFD RAISEDCHAR)
(GO EXIT))
NIL)
(COND
(PEEKEDECHOED (SETQ PEEKEDECHOED NIL))
(T (\ECHOCHAR C))) (* Here if it isn't a terminal class.
Only echo if it isn't a special terminal class)
(\BOUT \LINEBUF.OFD RAISEDCHAR)
(AND (EQ FILLTYPE READC.FT)
(GO NEXT))
(COND
((EQ ESCAPE.RC (SETQ RSNX (\SYNCODE RTBLSA RAISEDCHAR)))
(* On Tenex the escape inhibits the action of all
terminal characters except control-V.)
(COND
([EQ CTRLV.TC (SETQ TCLASS (fetch TERMCLASS of (\SYNCODE \PRIMTERMSA (SETQ RAISEDCHAR
(\GETCHAR]
(GO REDO)))
(\BOUT \LINEBUF.OFD RAISEDCHAR)
(GO NEXT)))
(SELECTC FILLTYPE
[RATOM/RSTRING.FT (COND
((AND CONTROLTON (fetch STOPATOM of RSNX))
(GO EXIT]
[READ.FT (COND
([AND CONTROLTON (ZEROP (fetch (LINEBUFFER LBRKCOUNT) of \LINEBUF.OFD))
(ZEROP (fetch (LINEBUFFER LPARCOUNT) of \LINEBUF.OFD))
(fetch STOPATOM of RSNX)
(SELECTC RSNX
((LIST LEFTPAREN.RC LEFTBRACKET.RC)
NIL)
(STRINGDELIM.RC (fetch (LINEBUFFER INSTRINGP)
of \LINEBUF.OFD))
(NOT (fetch (LINEBUFFER INSTRINGP) of \LINEBUF.OFD]
(* READ is reading an atom. Return when atom ends, but
also obey bracket/paren exception noted on page 14.33
of manual.)
(GO EXIT)))
(COND
((\INCPARENCOUNT RSNX)
(* Parens balance--throw the carriage if the closing paren or bracket character was not a CR, and if FLG argument of
READ is NIL. (We know we are under a READ call because of FILLTYPE))
(\CLOSELINE) (* \CLOSELINE first so dribble happens before EOL)
(AND (NEQ RAISEDCHAR (CHARCODE EOL))
(NOT FLG)
(\OUTCHAR \TERM.OFD (CHARCODE EOL)))
(RETURN))
((EQ IMMEDIATE.RMW (fetch WAKEUP of RSNX))
(* Immediate read-macro)
(GO EXIT]
(SHOULDNT))
(GO NEXT)
EXIT(\CLOSELINE])
)
(PUTPROPS FILLBUFFERPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (367 10937 (\FILLBUFFER 377 . 10935)))))
STOP