Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0004/txdt.10
There are no other files named txdt.10 in the archive.
(FILECREATED "27-JUN-78 14:26:13" <MASINTER>TXDT.;2 197933
changes to: JRST EDITWRITE TXDTCOMS TXDTRECORD TXDTADDR
TXDTGRABBEDOBJ TXDTBUFFER
previous date: " 7-FEB-78 20:43:15" <LISPUSERS>TXDT.;335)
(PRETTYCOMPRINT TXDTCOMS)
(RPAQQ TXDTCOMS ((FNS * TXDTFNS)
(VARS TXDTINSERTFILEKEY TXDTINSERTMSGKEY (STRINGPOINTERTEMP
(MKSTRING))
(TXDTSCRATCHSTRING (CONCAT
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXX"))
(NCHARSTXDTSCRATCHSTRING (NCHARS TXDTSCRATCHSTRING))
(EDITREADFILELST NIL)
(TXDTPTRCHAR (QUOTE ^))
(TXDTPMAPCNT 0)
(TXDTSWAPCNT 0)
(TXDTRECORDCNT 0)
(TXDTBUFFERCNT 0)
(TXDTADDRCNT 0)
(TXDTGRABBEDOBJCNT 0)
(TXDTEXTENSION NIL)
(TXDTPOETFLG NIL)
(TXDTEOLPNOTINTERRUPTED NIL)
(TXDTRESETFORMBREAKLOCKSFLG NIL)
(TXDTCURBUFLST NIL)
(TXDTCHARACTER0 (CHARACTER 0))
(TXDTTEMPSOURCEBOX 0)
(TXDTSCRATCHFILE T)
(TXDTESCAPECHAR NIL)
(TXDTPRINTUSERFNBOX NIL)
HIDDENFNS)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS TXDTRECORD TXDTADDR
TXDTGRABBEDOBJ
TXDTBUFFER)
(PROP AMAC DCLCONSTS CALCOFFSET NREFE)
(PROP MACRO PACKJFNPG BYTEPOINTER STRINGBASE
TXDTSETQQ JRST))
(BLOCKS (TXDT BTMRECP TOPRECP GETBTMREC GETTOPREC MARKEDP
CALCOFFSET COUNTEOLS EDITCHAR EDITCHAR1 EDITCHAR2
EDITUNSPLITCRLF EDITCHAR3 EDITCLOSEALL EDITCLOSEF
EDITCLOSEST EDITCOPYGRABBED EDITCOUNTLC
EDITDELETE EDITGOTO EDITGRAB EDITGREATERP
EDITINSERT EDITMKSTRING EDITMOVE EDITMOVEC
EDITMOVEL EDITPRINT EDITSEARCH EDITSUBST
EDITWRITE LOADREC PMAP PRINTSEG SWAPIN SWAPOUT
TXDTADDRP TXDTANCHOREDFIND TXDTBOX TXDTBOXRECPOS
TXDTBREAKLOCKS TXDTCHAR TXDTCLOSEALL TXDTCLOSEF
TXDTCLOSEST TXDTCOPY TXDTCOUNTLC TXDTDELETE
TXDTEQUAL TXDTFIND TXDTGOTO TXDTGRAB TXDTGRABBEDP
TXDTGREATERP TXDTINSERT TXDTMKSTRING TXDTMOVE
TXDTPRINT TXDTREAD TXDTSUBST TXDTUNBOX
TXDTUNBOXRECPOS TXDTVALIDP TXDTWRITE UNLOCK
UNMARK TXDTVERIFYADDR TXDTEOLP TXDTFREESPACE
EDITRESETSAVEFN TXDTCONTIGP TXDTCONTIGIFY
TXDTEMPTYP TXDTCURBUF EDITCONTIGP TXDTKILLBUF
TXDTRESETFORMFN REOPENFILE SMASHJFN EDITPUTMSG
TXDTPUTMSG TXDTGETMSG TXDTGETMSGLST TXDTMAPMSG
EDITINSERTESCAPE TXDTFILEPOSITION TXDTUNPMAP
TXDTSUBSTJFNS TXDTGETNEWJFN TXDTWHEREIS
EDITFINDSPLITREC EDITMAPCHARS TXDTMAPCHARS
TXDTCOUNTPIECES TXDTINIT TXDTPIECE TXDTNEXTPIECE
TXDTPREVPIECE
(ENTRIES TXDTADDRP TXDTBOX TXDTBREAKLOCKS
TXDTCHAR TXDTCLOSEALL TXDTCLOSEF
TXDTCLOSEST TXDTCOPY TXDTCOUNTLC
TXDTDELETE TXDTEQUAL TXDTFIND TXDTGOTO
TXDTGRAB TXDTGRABBEDP TXDTGREATERP
TXDTINSERT TXDTMKSTRING TXDTMOVE
TXDTPRINT TXDTREAD TXDTSUBST TXDTUNBOX
TXDTVALIDP TXDTWRITE TXDTEOLP
TXDTFREESPACE EDITRESETSAVEFN
TXDTCONTIGP TXDTCONTIGIFY TXDTEMPTYP
TXDTCURBUF TXDTKILLBUF TXDTRESETFORMFN
TXDTPUTMSG TXDTGETMSG TXDTGETMSGLST
TXDTMAPMSG TXDTFILEPOSITION TXDTUNPMAP
TXDTSUBSTJFNS TXDTGETNEWJFN TXDTWHEREIS
TXDTMAPCHARS TXDTCOUNTPIECES TXDTINIT
TXDTPIECE TXDTNEXTPIECE TXDTPREVPIECE)
(NOLINKFNS TXDTPRINTUSERFN TXDTGETNEWJFN)
(BLKLIBRARY MEMB EQUAL ASSOC)
(LOCALFREEVARS TXDTPOETFLG)
(GLOBALVARS BASEADDR BTMREC EDITCHARCODE
EDITCHARPOS EDITCHARREC EDITCOUNTC
EDITCOUNTL EDITDELETEPOS
EDITDELETEREC EDITGOTOPOS EDITGOTOREC
EDITINSERTPOS1 EDITINSERTPOS2
EDITINSERTREC1 EDITINSERTREC2
EDITMOVECPOS EDITMOVECREC
EDITMOVELPOS EDITMOVELREC
EDITREADFILELST EDITSEARCHPOS1
EDITSEARCHPOS2 EDITSEARCHREC1
EDITSEARCHREC2 FINDFIRSTMODE
FINDNCHARSNLEFT FINDNCHARSOFF
NCHARSTXDTSCRATCHSTRING OFFSET1
OFFSET2 TXDTPAGE1 TXDTPAGE1CNT
TXDTPAGE1CONTENTS TXDTPAGE1LOCK
TXDTPAGE2 TXDTPAGE2CNT
TXDTPAGE2CONTENTS TXDTPAGE2LOCK
TXDTSWAPCNT TXDTSCRATCHSTRING TOPREC
TXDTDELTA TXDTEXTENSION TXDTGRABADDR
TXDTPMAPCNT TXDTPTRCHAR TXDTSUBSTCNT
TXDTSWAPCNT TXDTUNBOXPOS TXDTPOETFLG
TXDTPOETDOT TXDTPOETDOTADDR TXDT$
TXDTCLOSESTFORWFLG TXDTVERIFYPOS
TXDTEOLPTEXT TXDTEOLPNOTINTERRUPTED
TXDTEOLPOFFSET2 TXDTEOLPANS
TXDTFINDCNT EDITCLOSESTLST
TXDTRESETFORMBREAKLOCKSFLG
TXDTSCRATCHFILE TXDTCURBUFLST
TXDTCURBUF TXDTRECORDCNT TXDTADDRCNT
TXDTBUFFERCNT TXDTGRABBEDOBJCNT
EDITPAGEINFO TXDTINSERTFILEKEY
TXDTESCAPECHAR TXDTPRINTPTRBOX
TXDTINSERTFILEPOS1BOX
TXDTINSERTFILEPOS2BOX
TXDTINSERTPOS1BOX TXDTINSERTPOS2BOX
LOADRECSOURCEBOX EDITUNLOCKSOURCEBOX
EDITPACKJFNPGBOX TXDTPRINTUSERFNBOX
SMASHEDRECHASHARRAY EDITCLOSESTREC
TXDTMAXMSGLEN EDITCOUNTSTOPREC
EDITCOUNTSTOPPOS TXDTMSGBUFFER
TXDTCHARACTER0 TXDTTEMPSOURCEBOX)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)))))
(RPAQQ TXDTFNS (BTMRECP CALCOFFSET COUNTEOLS EDITCHAR EDITCHAR1
EDITCHAR2 EDITCHAR3 EDITCLOSEALL EDITCLOSEF
EDITCLOSEST EDITCONTIGP EDITCOPYGRABBED
EDITCOUNTLC EDITDELETE EDITFINDSPLITREC
EDITGOTO EDITGRAB EDITGREATERP EDITINSERT
EDITINSERTESCAPE EDITMAPCHARS EDITMKSTRING
EDITMOVE EDITMOVEC EDITMOVEL EDITPRINT
EDITPUTMSG EDITRESETSAVEFN EDITSEARCH EDITSUBST
EDITUNSPLITCRLF EDITWRITE GETBTMREC GETTOPREC
LOADREC MARKEDP PMAP PRINTSEG REOPENFILE RTXDT
SMASHJFN SWAPIN SWAPOUT TOPRECP TXDTADDRP
TXDTANCHOREDFIND TXDTBOX TXDTBOXRECPOS
TXDTBREAKLOCKS TXDTCHAR TXDTCLOSEALL TXDTCLOSEF
TXDTCLOSEST TXDTCONTIGIFY TXDTCONTIGP TXDTCOPY
TXDTCOUNTLC TXDTCOUNTPIECES TXDTCURBUF
TXDTDELETE TXDTEMPTYP TXDTEOLP TXDTEQUAL
TXDTFILEPOSITION TXDTFIND TXDTFREESPACE
TXDTGETMSG TXDTGETMSGLST TXDTGETNEWJFN TXDTGOTO
TXDTGRAB TXDTGRABBEDP TXDTGREATERP TXDTINIT
TXDTINSERT TXDTKILLBUF TXDTMAPCHARS TXDTMAPMSG
TXDTMKSTRING TXDTMOVE TXDTNEXTPIECE TXDTPIECE
TXDTPREVPIECE TXDTPRINT TXDTPRINTUSERFN
TXDTPUTMSG TXDTREAD TXDTRESETFORMFN TXDTSUBST
TXDTSUBSTJFNS TXDTUNBOX TXDTUNBOXRECPOS
TXDTUNPMAP TXDTVALIDP TXDTVERIFYADDR
TXDTWHEREIS TXDTWRITE UNLOCK UNMARK))
(DEFINEQ
(BTMRECP
[LAMBDA (REC)
(EQ REC (fetch TXDTNEXT of REC])
(CALCOFFSET
[LAMBDA (INITBP ENDBP)
(* This function calculates N-1, where N is the number of bytes between
that pointed to by INITBP and that pointed to by ENDBP, not counting the
final byte. If W1 is the word address in INITBP and B1 is the bit count in
the upper 6 bits of INITBP, and W2 and B2 are those quanities in ENDBP,
then this function calculates: 5{W2-W1-1}+B1/7+{5-B2/7}-1)
(LOC (ASSEMBLE NIL
(CQ (VAG ENDBP))
(PUSHN 1)
(CQ (VAG INITBP))
(POPN 2) (* put INITBP in AC1 and ENDBP in AC2)
(CALCOFFSET) (* then use AMAC defn of this function)
])
(COUNTEOLS
[LAMBDA (STR) (* counts the number of EOLs in string
STR)
(LOC (ASSEMBLE NIL
(CQ (SETQ BASEADDR (STRINGBASE STR))
(VAG (BYTEPOINTER BASEADDR OFFSET2)))
(PUSHN 1)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(MOVE 2 , 1)
(POPN 3)
(MOVEI 1 , 0) (* now fetch from AC2 till AC3, counting
EOLs in AC1.)
LOOP(CAMN 2 , 3)
(JUMPA EXIT)
(ILDB 4 , 2)
(CAIN 4 , 37Q)
(ADDI 1 , 1)
(JUMPA LOOP)
EXIT])
(EDITCHAR
[LAMBDA (REC POS BACKWARDS)
(* returns the ASCII code of char at REC,POS and sets
EDITCHARREC,EDITCHARPOS to location of next/prev char, depending on
BACKWARDS. CR/LF is treated as one char and returned as EOL.
Uses three aux funcstion, EDITCHAR1-3.)
(PROG NIL
(* A sketch of whats to come: EDITCHARREC,EDITCHARPOS will always be where
the action is. BASEADDR and OFFSET1 will always remain set to the character
currently under consideration. EDITCHAR1 fetches this character, EDITCHAR2
and EDITCHAR3 move the globals over to the next/prev character,
respectively. We first fetch the char at REC,POS. If its a CR we see if the
next is a LF and if so, move two. If its a LF, we see if the prev is a CR,
and if so, move two. In both cases we return EOL. The move two is clearly
in the right direction.)
(SETQ EDITCHARREC REC)
(SETQ EDITCHARPOS POS)
[COND
((BTMRECP REC)
(SETQ EDITCHARCODE NIL))
(T (LOADREC EDITCHARREC EDITCHARPOS EDITCHARPOS)
(SETQ EDITCHARCODE (EDITCHAR1]
(COND
[(EQ EDITCHARCODE 13)
(OR (EDITCHAR2 T)
(GO EXIT))
(COND
[(EQ (EDITCHAR1)
10)
(SETQ EDITCHARCODE 31)
(COND
(BACKWARDS (EDITCHAR3)
(GO STEPBACK))
(T (EDITCHAR2)
(GO EXIT]
(BACKWARDS (EDITCHAR3)
(GO STEPBACK))
(T (GO EXIT]
[(EQ EDITCHARCODE 10)
(OR (EDITCHAR3 T)
(GO EXIT))
(COND
[(EQ (EDITCHAR1)
13)
(SETQ EDITCHARCODE 31)
(COND
(BACKWARDS (GO STEPBACK))
(T (EDITCHAR2)
(EDITCHAR2)
(GO EXIT]
(BACKWARDS (GO EXIT))
(T (EDITCHAR2)
(EDITCHAR2)
(GO EXIT]
(BACKWARDS (GO STEPBACK))
(T (EDITCHAR2)
(GO EXIT)))
STEPBACK
(OR (EDITCHAR3 T)
(GO EXIT))
[COND
((EQ (EDITCHAR1)
10)
(OR (EDITCHAR3 T)
(GO EXIT))
(COND
((EQ (EDITCHAR1)
13)
(GO EXIT))
(T (EDITCHAR2]
EXIT(RETURN EDITCHARCODE])
(EDITCHAR1
[LAMBDA NIL (* used by EDITCHAR to fetch the byte at
BASEADDR,OFFSET1)
(LOC (ASSEMBLE NIL
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(ILDB 1 , 1])
(EDITCHAR2
[LAMBDA (LOADFLG)
(* used by EDITCHAR to move EDITCHARREC,EDITCHARPOS one position forward
and set OFFSET1 to the offset from baseaddr of the corresponding character.
Does not bother to load a new rec unless the flag is set.
Returns NIL if bottom is hit.)
(COND
((ILESSP (SETQ EDITCHARPOS (ADD1 EDITCHARPOS))
(fetch TXDTOFFSET2 of EDITCHARREC))
(* if we can move forward one on this
rec, do it)
(SETN OFFSET1 (ADD1 OFFSET1))
T)
((BTMRECP (SETQ EDITCHARREC (fetch TXDTNEXT of EDITCHARREC)))
(* if we step forward and hit btm,
return NIL)
(SETQ EDITCHARPOS 0)
NIL)
(T (* otherwise, set pos and load rec if
needed)
(SETQ EDITCHARPOS (fetch TXDTOFFSET1 of EDITCHARREC))
(AND LOADFLG (LOADREC EDITCHARREC EDITCHARPOS EDITCHARPOS))
T])
(EDITCHAR3
[LAMBDA (LOADFLG) (* like EDITCHAR2 but backwards)
(COND
((ILESSP (SETQ EDITCHARPOS (SUB1 EDITCHARPOS))
(fetch TXDTOFFSET1 of EDITCHARREC))
(* if no room on this rec step to prev)
(COND
((TOPRECP (SETQ EDITCHARREC (fetch TXDTPREV of EDITCHARREC)))
(* if prev is top, return NIL)
(SETQ EDITCHARREC (fetch TXDTNEXT of EDITCHARREC))
(SETQ EDITCHARPOS (fetch TXDTOFFSET1 of EDITCHARREC))
NIL)
(T (* otherwise, set pos and load if nec)
(SETQ EDITCHARPOS (SUB1 (fetch TXDTOFFSET2 of EDITCHARREC))
)
(AND LOADFLG (LOADREC EDITCHARREC EDITCHARPOS EDITCHARPOS))
T)))
(T (* if ok to move back on this rec, reset
offset)
(SETN OFFSET1 (SUB1 OFFSET1))
T])
(EDITCLOSEALL
[LAMBDA NIL
(PROG1 EDITREADFILELST (SWAPOUT TXDTPAGE1)
(SWAPOUT TXDTPAGE2)
[MAPC EDITREADFILELST (FUNCTION (LAMBDA (FILE)
(COND
((OPENP FILE)
(CLOSEF FILE]
(SETQ EDITREADFILELST NIL])
(EDITCLOSEF
[LAMBDA (FILEJFN)
(* close file with jfn FILEJFN. Un-PMAPs any pages associated with that
file first.)
(PROG NIL
[COND
((NOT (NUMBERP FILEJFN))
(COND
((NOT (OPENP FILEJFN))
(RETURN NIL)))
(SETQ FILEJFN (OPNJFN FILEJFN]
(COND
((EQ (LRSH TXDTPAGE1CONTENTS 18)
FILEJFN)
(SWAPOUT TXDTPAGE1)))
(COND
((EQ (LRSH TXDTPAGE2CONTENTS 18)
FILEJFN)
(SWAPOUT TXDTPAGE2)))
(SETQ FILEJFN (CLOSEF (JFNS FILEJFN)))
(SETQ EDITREADFILELST (REMOVE FILEJFN EDITREADFILELST))
(RETURN FILEJFN])
(EDITCLOSEST
[LAMBDA (REC POS RPALST)
(* RPALST is a list of the form (rec pos . address) and this fn finds the rec,pos on that list which is closest to
REC,POS and returns the corresponding address. This function may also return TOP or BTM if that is closer than
anything on the list. Thus, if the list is initially empty, the fn will always return either TOP or BTM.
The method used is to search up and down from REC,POS simultaneously until finding one of the distinguished
addresses, and then searching only in the other direction until the either a closer address is found or the distance
is exceeded.)
(PROG (BREC FREC BPOS FPOS FOUNDBFLG FOUNDFFLG BDELTA FDELTA BADDR FADDR)
(SETQ BREC (SETQ FREC REC))
(SETQ BDELTA (IDIFFERENCE POS (fetch TXDTOFFSET1 of BREC)))
(SETQ FDELTA (IDIFFERENCE (fetch TXDTOFFSET2 of FREC)
POS))
LP [OR FOUNDBFLG (COND
([for RPA in RPALST thereis (AND (EQ BREC (CAR RPA))
(OR (NEQ BREC REC)
(NOT (IGREATERP (CADR RPA)
POS]
(SETQ BPOS -10000)
[for RPA in RPALST do (COND
((AND (EQ BREC (CAR RPA))
(OR (NEQ BREC REC)
(NOT (IGREATERP (CADR RPA)
POS)))
(IGREATERP (CADR RPA)
BPOS))
(SETQ BPOS (CADR RPA))
(SETQ BADDR (CDDR RPA]
[SETQ BDELTA (COND
((EQ BREC REC)
(IDIFFERENCE POS BPOS))
(T (IPLUS BDELTA (fetch TXDTOFFSET2 of BREC)
(IMINUS BPOS]
(SETQ FOUNDBFLG T))
((TOPRECP BREC)
(SETQ BADDR (QUOTE TOP))
(SETQ FOUNDBFLG T))
((NEQ BREC REC)
(SETQ BDELTA (IPLUS BDELTA (fetch TXDTOFFSET2 of BREC)
(IMINUS (fetch TXDTOFFSET1 of BREC]
[OR FOUNDFFLG (COND
([for RPA in RPALST thereis (AND (EQ FREC (CAR RPA))
(OR (NEQ FREC REC)
(IGREATERP (CADR RPA)
POS]
(SETQ FPOS 10000)
[for RPA in RPALST do (COND
((AND (EQ FREC (CAR RPA))
(OR (NEQ FREC REC)
(IGREATERP (CADR RPA)
POS))
(ILESSP (CADR RPA)
FPOS))
(SETQ FPOS (CADR RPA))
(SETQ FADDR (CDDR RPA]
[SETQ FDELTA (COND
((EQ FREC REC)
(IDIFFERENCE FPOS POS))
(T (IPLUS FDELTA FPOS (IMINUS (fetch TXDTOFFSET1 of FREC]
(SETQ FOUNDFFLG T))
((BTMRECP FREC)
(SETQ FPOS 0)
(SETQ FADDR (QUOTE BTM))
(SETQ FOUNDFFLG T))
((NEQ FREC REC)
(SETQ FDELTA (IPLUS FDELTA (fetch TXDTOFFSET2 of FREC)
(IMINUS (fetch TXDTOFFSET1 of FREC]
[COND
[FOUNDBFLG (COND
[FOUNDFFLG (COND
((ILESSP BDELTA FDELTA)
(SETQ TXDTCLOSESTFORWFLG NIL)
(SETQ EDITCLOSESTREC BREC)
(RETURN BADDR))
(T (SETQ TXDTCLOSESTFORWFLG T)
(SETQ EDITCLOSESTREC FREC)
(RETURN FADDR]
((IGREATERP FDELTA BDELTA)
(SETQ TXDTCLOSESTFORWFLG NIL)
(SETQ EDITCLOSESTREC BREC)
(RETURN BADDR]
(FOUNDFFLG (COND
((IGREATERP BDELTA FDELTA)
(SETQ TXDTCLOSESTFORWFLG T)
(SETQ EDITCLOSESTREC FREC)
(RETURN FADDR]
(OR FOUNDBFLG (SETQ BREC (fetch TXDTPREV of BREC)))
(OR FOUNDFFLG (SETQ FREC (fetch TXDTNEXT of FREC)))
(GO LP])
(EDITCONTIGP
[LAMBDA (REC1 POS1 REC2 POS2) (* Returns T iff the text between the two addresses is
contiguously on a file -- not necessarily same rec
though!)
(PROG (NEXTREC1 NEXTSOURCE1)
[COND
((BTMRECP REC1) (* If we are starting at BTM, then return NIL unless
window emtpy)
(RETURN (EQ REC1 REC2]
(EDITMOVEC 1 REC2 POS2 T) (* Back up to last char.)
LOOP[COND
((EQ REC1 EDITMOVECREC) (* If we have finally pushed REC1 to the rec at the end
of the window, just check offsets to be sure)
(RETURN (NOT (ILESSP EDITMOVECPOS POS1]
(SETQ NEXTREC1 (fetch TXDTNEXT of REC1)) (* Get the next rec to see if the step from REC1 to next
is contig)
(COND
((BTMRECP NEXTREC1) (* If we have hit btm we have failed, since REC2
couldn't possibly be btm, since we backed it up by one)
(RETURN NIL)))
(COND
([OR (AND (IEQP (SETN TXDTTEMPSOURCEBOX (fetch TXDTSOURCE of REC1))
(SETN NEXTSOURCE1 (fetch TXDTSOURCE of NEXTREC1)))
(IEQP (fetch TXDTOFFSET2 of REC1)
(fetch TXDTOFFSET1 of NEXTREC1)))
(AND (IEQP (fetch TXDTOFFSET2 of REC1)
2560)
(EQ (fetch TXDTOFFSET1 of NEXTREC1)
0)
(EQ (LRSH|TXDTTEMPSOURCEBOX 18)
(LRSH NEXTSOURCE1 18))
(EQ (ADD1|(LOGAND TXDTTEMPSOURCEBOX 262143))
(LOGAND NEXTSOURCE1 262143]
(* It is ok to continue, that is, the step from REC1 to NEXTREC1 is contiguous iff both recs address the same
filepage and have adjacent boundaries, or they address successive file pages and to end of first and start on
beginning of next page.)
(SETQ REC1 NEXTREC1)
(SETQ POS1 (fetch TXDTOFFSET1 of REC1))
(GO LOOP))
(T (RETURN NIL])
(EDITCOPYGRABBED
[LAMBDA (REC)
(* It is assumed that REC is a grabbed object not inserted.
Thus its final NEXT is NIL and its first PREV is NIL, so we can look it in
the face and copy it. Be careful to make copies of all of the TEXTs, so as
not to confuse addressing.)
(PROG (TEMP)
(COND
((NLISTP REC)
(* if we have hit the bottom, return NIL or "", whichever it is...)
(RETURN REC)))
(SETQ TEMP (fetch TXDTSOURCE of REC))
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ REC (create TXDTRECORD TXDTSOURCE _(IPLUS TEMP)
TXDTOFFSET1 _(fetch TXDTOFFSET1
of REC)
TXDTOFFSET2 _(fetch TXDTOFFSET2
of REC)
TXDTPREV _ NIL TXDTNEXT _(SETQ TEMP
(EDITCOPYGRABBED (fetch TXDTNEXT
of REC)))
TXDTSPLITRECS _ NIL TXDTMSG _(FETCH TXDTMSG
OF REC)))
(* copy REC, carefully copying the TEXT. Note that NEXT is copied and
pointed to, but we don't know who PREV should be, so we leave it NIL.
On the top this is desirable. However, we know PREV for the rec now in
NEXT, so set it.)
(COND
(TEMP
(* if NEXT of the copy is not NIL, set its PREV to this one)
(replace TXDTPREV of TEMP with REC)))
(RETURN REC])
(EDITCOUNTLC
[LAMBDA (REC1 POS1 REC2 POS2 JUSTCHARS SCRATCHNO STOPCHAR)
(* counts the lines and chars between REC1,POS1 and REC2,POS2 or first occurrence of STOPCHAR when not counting
JUSTCHARS. If JUSTCHARS is T it just counts the number of chars, counting EOL as two. Otherwise, it counts the
number of lines between the two points, and the number of chars from the beginning of the last line to the second
point. The answer, in both cases, is returned in the globals EDITCOUNTL and EDITCOUNTC. If counting just chars,
SCRATCHNO is used as a number box to hold char count, else to hold line count.)
(SETQ EDITCOUNTSTOPREC NIL)
(COND
((BTMRECP REC1) (* if there is nothing to do, don't try to do anything!)
(SETQ EDITCOUNTL 0)
(SETQ EDITCOUNTC 0))
((AND JUSTCHARS (NOT STOPCHAR)) (* if just counting chars, we can do it at the record
level provided we are not looking for a stop char too.)
(PROG NIL
(SETQ EDITCOUNTL 0)
(SETQ EDITCOUNTC SCRATCHNO)
(COND
((AND (EQ REC1 REC2)
(NOT (IGREATERP POS1 POS2)))
(SETN EDITCOUNTC (IDIFFERENCE POS2 POS1))
(RETURN)))
(SETN EDITCOUNTC (IDIFFERENCE (fetch TXDTOFFSET2 of REC1)
POS1))
LOOP(SETQ REC1 (fetch TXDTNEXT of REC1))
(COND
((EQ REC1 REC2)
[SETN EDITCOUNTC (IPLUS EDITCOUNTC (IDIFFERENCE POS2 (fetch TXDTOFFSET1
of REC2]
(RETURN))
((BTMRECP REC1)
(RETURN)))
[SETN EDITCOUNTC (IPLUS EDITCOUNTC (IDIFFERENCE (fetch TXDTOFFSET2 of REC1)
(fetch TXDTOFFSET1 of REC1]
(GO LOOP)))
(T (SETQ REC1 (fetch TXDTPREV of REC1)) (* tactical retreat to prepare for first rec step taken
at NEXTREC to load the first rec.)
(SETQ EDITCOUNTL SCRATCHNO)
(ASSEMBLE NIL
TOP
(* a brief sketch: we will keep the current char and line counts in AC1 and AC2 The bps for the window will be in
AC3 and AC4. NEXTREC will be PUSHJd to set up the bps. It will save the contents of AC1 and AC2 while it does so.
If it finds that we have completed the entire scan, it jumps to FINISHED which will set EDITCOUNTL and EDITCOUNTC
from their saved values and exit. Every time we hit a LF or EOL we will jump to FOUNDLINE to take the approp action.
This will consist of checking JUSTCHARS and possiblying incrementing the line count and reseting the char count.
The only other tricky bit is CHKCRLF which is for verifying that we have a LF pair before jumpting off to FOUNDLINE.
Lone CRs don't count as lines.)
(DCLCONSTS ((STOPCHARCODE -3)
(SAVE-AC1 -2)
(SAVE-AC2 -1)
(RETURN-LINK 0)))
(PUSHNN (= 0)
(= 0)
(= 0)
(= 0))
(* save three number slots for storing AC1 and AC2 and return link into when we need to protect them from NEXTREC.
And a slot to hold unboxed stop char code.)
[CQ (VAG (COND
(STOPCHAR (CHCON1 STOPCHAR))
(T -1]
(NREFE (MOVEM 1 , STOPCHARCODE))
(MOVEI 1 , 0) (* initialize char count)
(MOVEI 2 , 0) (* and line count)
(JSP 6 , NEXTREC) (* go get next rec)
CHARLOOP
(ILDB 5 , 3) (* fetch next char)
(ADDI 1 , 1) (* incrmt char count)
(NREFE (CAMN 5 , STOPCHARCODE))
(JRST FOUNDSTOPCHAR)
CHKLINE
(CAIN 5 , 12Q) (* if the char is a LF)
(JRST FOUNDLINE) (* go process eol.)
CHKEND
(CAMN 3 , 4) (* see if at end of current window)
(JSP 6 , NEXTREC) (* if so, go get next rec -- note: we may not return
from here if this completes the scan!)
(JUMPA CHARLOOP) (* otherwise, loop)
FOUNDLINE
(* we get here when we have found a LF. We want to take no action if JUSTCHARS is set, but otherwise we want to
incrmt the line count in AC2 and zero the char count.)
(LDV2 (QUOTE JUSTCHARS)
SP 5) (* put the flag into AC5 -- we don't care about the char
there any more)
(CAME 5 , KNIL) (* compare it to NIL)
(JUMPA CHKEND) (* if its T, continue main loop)
(ADDI 2 , 1) (* otherwise incrmt line count)
(MOVEI 1 , 0) (* zero char count)
(JUMPA CHKEND) (* and continue main loop -- isn't this developing into
a classic EDIT-type function?)
NEXTREC
(* we get here if its time to step to a new rec. We do this in LISP. So we want to save AC1 and AC2 since they have
our counts in them. And AC6 because it has our return link)
(SUBI 6 , TOP)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
(NREFE (MOVEM 6 , RETURN-LINK)) (* ok, now that they are safe, go to it)
NEXTREC+2
(* if we ever have to skip a rec because the offsets are crossed we loop thru here rather than NEXTREC to avoid
pushing again.)
[CQ (PROGN (COND
((EQ REC1 REC2) (* if we are done, quit)
(JRST FINISHED)))
(SETQ REC1 (fetch TXDTNEXT of REC1)) |
| (* step rec forward)
(COND |
((BTMRECP|REC1) (* if hit btm, quit)
(JRST FINISHED)))
(LOADREC REC1 (OR POS1 (fetch TXDTOFFSET1 of REC1))
(AND (EQ REC1 REC2)
POS2)) |
(SETQ POS1 NIL)
|
(* load the rec Note that the first time, POS1 is non-NIL and used as the first offset. Thereafter it is NIL and the
first offset|of the rec is used instead.)
|
|
(COND |
((NOT (ILESSP OFFSET1 OFFSET2)) |
| (* if the offsets are screwed, skip rec -- probably at
end now)
(JRST NEXTREC+2))) (* construct end bp)
(VAG (BYTEPOINTER BASEADDR OFFSET2]
(PUSHN 1) (* push it)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(* construct init bp)
(MOVE 3 , 1) (* move it to AC3)
(POPN 4) (* and put end bp into AC4)
(NREFE (MOVE 2 , SAVE-AC2))
(NREFE (MOVE 1 , SAVE-AC1)) (* restore ACs 1 and 2 to their respective counts and
load AC6 with return link)
(NREFE (MOVE 6 , RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6) (* and return from whence we came)
FOUNDSTOPCHAR
(* Ok, we have found the stop char. We must save the location REC,POS at which the char occurs before we exit with
the current line and char counts. We'll store the answer loc in EDITCOUNTSTOPREC,EDITCOUNTSTOPPOS and because the
first was set to NIL before we started this will be sufficient to signal that we actually found the stop char
instead of running off the end.)
(NREFE (MOVEM 1 , SAVE-AC1)) (* save current line and char counts from destruction.)
(NREFE (MOVEM 2 , SAVE-AC2))
(NREFE (MOVEM 3 , STOPCHARCODE)) (* save current bp)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(* put init bp into ac1)
(NREFE (MOVE 2 , STOPCHARCODE)) (* put final bp in ac2)
(CALCOFFSET) (* put difference in ac1 and box it)
(CQ (LOC (AC)))
(SETQ EDITCOUNTSTOPPOS)
(CQ (SETQ EDITCOUNTSTOPPOS (IPLUS EDITCOUNTSTOPPOS OFFSET1 -2734Q))
(SETQ EDITCOUNTSTOPREC REC1)) (* now fall thru to normal finish.
Note cleverness in saving ac1 and ac2.)
FINISHED
(* we get here, as one might guess, when we have exhausted the whole REC1,POS1 REC2,POS2 area -- or hit btm.
At this moment our ans are on the stack. We want to fetch them, box them up and put them in their respective
globals.)
(NREFE (MOVE 1 , SAVE-AC2)) (* get the line count)
(VAR (PSETN EDITCOUNTL)) (* and put it into EDITCOUNTL)
(NREFE (MOVE 1 , SAVE-AC1)) (* repeat for char count)
(CQ (LOC (AC))) (* but box it)
(SETQ EDITCOUNTC)
(POPNN 4])
(EDITDELETE
[LAMBDA (REC1 POS1 REC2 POS2 COUNTLCFLG)
(* Deletes the text from REC1,POS1 to but not thru REC2,POS2.
Sets EDITDELETEREC,EDITDELETEPOS to location immediately following deleted
text. Markes any record entirely removed from the buffer by settings its
TXDTOFFSET2 to TXDTOFFSET2-2561. The logic behind this is as follows: While
we think of the offsets in a rec being bytepointers from 0 to 2560, they
are really in the range -1500 to 2560-1500, to keep them small.
By substracting 2561 we insure that the offset is less than -1500 and thus
distinguished as illegal. UNMARK unmarks deleted records.)
(PROG (TEMPREC OLDINTERRUPTABLEVAL)
[COND
(COUNTLCFLG (* if to count window, do it now)
(EDITCOUNTLC REC1 POS1 REC2 POS2
(EQ COUNTLCFLG (QUOTE CHARS)))
(SETQ TXDTDELTA (COND
((EQ COUNTLCFLG (QUOTE CHARS))
(IMINUS EDITCOUNTC))
((EQ COUNTLCFLG (QUOTE LINES))
(IMINUS EDITCOUNTL))
(T (CONS (IMINUS EDITCOUNTL)
(QUOTE
UNABLE-TO-GIVE-MEANINGFUL-CHAR-COUNT]
(* Now we must make sure that the window
is well-defined)
(SETQ TEMPREC REC1)
CHKLOOP
[COND
((NEQ TEMPREC REC2)
(COND
((BTMRECP TEMPREC) (* Hit BTM without finding REC2!)
(ERROR!))
(T (SETQ TEMPREC (fetch TXDTNEXT of TEMPREC))
(GO CHKLOOP]
(* So we know we can go from REC1 to REC2 without error.
Now see if POS's ok.)
(OR [AND (type? TXDTRECORD REC1)
(type? TXDTRECORD REC2)
(NOT (ILESSP POS1 -1500))
(NOT (ILESSP POS2 -1500))
(OR (NEQ REC1 REC2)
(NOT (IGREATERP POS1 POS2]
(ERROR!)) (* NOW ENTER UNINTERRUPTABLE SECTION.)
(SETQ OLDINTERRUPTABLEVAL (INTERRUPTABLE NIL))
(COND
[(EQ REC1 REC2) (* if same rec)
(COND
((IEQP POS1 (fetch TXDTOFFSET1 of REC1))
(* and if init seg to be deleted)
(COND
((IEQP POS2 (fetch TXDTOFFSET2 of REC1))
(* then if entire rec to be deleted,
just link it out)
(/replace TXDTPREV of (fetch TXDTNEXT
of REC1)
with (fetch TXDTPREV of REC1))
(/replace TXDTNEXT of (fetch TXDTPREV
of REC1)
with (fetch TXDTNEXT of REC1))
(/replace TXDTOFFSET2 of REC1
with (IDIFFERENCE (fetch TXDTOFFSET2
of REC1)
2561))
(* and mark REC1 as deleted)
(SETQ EDITDELETEREC (fetch TXDTNEXT of REC1))
(SETQ EDITDELETEPOS (fetch TXDTOFFSET1
of EDITDELETEREC)))
(T (* then simply chop it off and get out)
(/replace TXDTOFFSET1 of REC1 with POS2)
(SETQ EDITDELETEREC REC1)
(SETQ EDITDELETEPOS POS2)))
(INTERRUPTABLE OLDINTERRUPTABLEVAL)
(RETURN))
(T (* if init seg not to be deleted, save
it in new rec)
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ REC1 (create TXDTRECORD TXDTSOURCE _(fetch
TXDTSOURCE of REC2)
TXDTOFFSET1 _(fetch TXDTOFFSET1
of REC2)
TXDTOFFSET2 _ POS1 TXDTPREV _(
fetch TXDTPREV of REC2)
TXDTNEXT _ REC2 TXDTSPLITRECS _
NIL TXDTMSG _(fetch TXDTMSG
of REC2)))
(/replace TXDTSPLITRECS of REC2
with (NCONC1 (fetch TXDTSPLITRECS of REC2)
REC1))
(/replace TXDTNEXT of (fetch TXDTPREV of REC1)
with REC1) (* and link new rec from above)
]
((IEQP POS1 (fetch TXDTOFFSET1 of REC1))
(* if not same, and all of REC1 to be deleted, step back.
Loop below will see that REC1 gets marked as deleted.)
(SETQ REC1 (fetch TXDTPREV of REC1)))
(T (* if some of REC1 to be kept, thenchop
off unwanted part)
(/replace TXDTOFFSET2 of REC1 with POS1)))
(* now handle REC2 which is easier. First of all, we must scan down from
REC1 to REC2 marking all recs to be deleted.)
(SETQ TEMPREC REC1)
LOOP(SETQ TEMPREC (fetch TXDTNEXT of TEMPREC))
(COND
((NEQ TEMPREC REC2) (* as long as we don't have REC2, mark
it as deleted.)
(/replace TXDTOFFSET2 of TEMPREC
with (IDIFFERENCE (fetch TXDTOFFSET2 of TEMPREC)
2561))
(GO LOOP))) (* ok, we have reached REC2 and marked
the intervening records as deleted)
(COND
((IEQP POS2 (fetch TXDTOFFSET2 of REC2))
(* if all of REC2 to be deleted, just step over it after marking it too)
(/replace TXDTOFFSET2 of REC2
with (IDIFFERENCE (fetch TXDTOFFSET2 of REC2)
2561))
(SETQ REC2 (fetch TXDTNEXT of REC2))
(SETQ POS2 (fetch TXDTOFFSET1 of REC2)))
(T (* otherwise, only some to be deleted.)
(/replace TXDTOFFSET1 of REC2 with POS2)
(* chop off unwanted part and reset line
cnt)
))
(/replace TXDTNEXT of REC1 with REC2)
(* link REC1 and REC2)
(/replace TXDTPREV of REC2 with REC1)
(* CRITICAL SECTION OVER.)
(INTERRUPTABLE OLDINTERRUPTABLEVAL)
(SETQ EDITDELETEREC REC2)
(SETQ EDITDELETEPOS POS2)
(RETURN])
(EDITFINDSPLITREC
[LAMBDA (OLDREC POS)
(* Finds the new rec which is a descendant of OLDREC and which still
contains POS. Ths fn is recursive!)
(PROG (ANS LST)
(COND
((AND (NOT (ILESSP POS (fetch TXDTOFFSET1 of OLDREC)))
(ILESSP POS (fetch TXDTOFFSET2 of OLDREC)))
(RETURN OLDREC)))
(SETQ LST (fetch TXDTSPLITRECS of OLDREC))
LOOP(COND
((NULL LST)
(RETURN NIL))
((SETQ ANS (EDITFINDSPLITREC (CAR LST)
POS))
(RETURN ANS)))
(SETQ LST (CDR LST))
(GO LOOP])
(EDITGOTO
[LAMBDA (LINENO CHARNO FLG) (* WARNING! THIS FUNCTION ONLY MAKES
SENSE ON THE CURRENT BUFFER!)
(* sets EDITGOTOREC,EDITGOTOPOS to the location of the CHARNOth char
following the LINENOth line. If LINENO is NIL, only char move is made.
Negative or zero LINENO is cosidered beyond TOP. Negative CHARNO is ok,
unless beyond TOP. If FLG is T and buffer bounds exceeded, sets EDITGOTOREC
to NIL.)
(COND
[(AND LINENO (ILESSP LINENO 1))
(COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!))
(FLG (SETQ EDITGOTOREC NIL))
(T (SETQ EDITGOTOREC (fetch TXDTNEXT of TOPREC))
(SETQ EDITGOTOPOS (fetch TXDTOFFSET1 of EDITGOTOREC]
(T (EDITMOVE (COND
((NULL LINENO)
NIL)
((EQ LINENO 1)
NIL)
(T (SUB1 LINENO)))
(AND (FIXP CHARNO)
(SUB1 CHARNO))
(fetch TXDTNEXT of TOPREC)
(fetch TXDTOFFSET1 of (fetch TXDTNEXT of TOPREC))
FLG)
(SETQ EDITGOTOREC EDITMOVECREC)
(SETQ EDITGOTOPOS EDITMOVECPOS])
(EDITGRAB
[LAMBDA (REC1 POS1 REC2 POS2 COUNTLCFLG)
(* grabs and returns the indicated text. Its affect on the buffer is just
like EDITDELETEs, but it returns a chain of recs representing the deleted
text. The PREV of the first rec and NEXT of the last in this chain are NIL;
therefore, the chain is suitable for insertion via EDITINSERT.
All of the OFFSET2s of the chain have been marked by the process described
in EDITDELTE. This marking is undone by EDITINSERT.
Until unmarked however, the object returned by EDITGRAB is not only deleted
from the buffer but marked so that any pointers to it will be classified as
invalid.)
(COND
((AND (EQ REC1 REC2)
(IEQP POS1 POS2)) (* if nothing to grab, return empty
string as the object.)
[COND
(COUNTLCFLG (SETQ TXDTDELTA (COND
((EQ COUNTLCFLG (QUOTE BOTH))
(CONS 0 0))
(T 0]
"")
(T (* otherwise, try to grab it and if it
hollers let it go.)
(RESETLST (RESETSAVE (RESETUNDO)
(QUOTE (EDITRESETSAVEFN)))
(PROG (LASTREC)
[COND
((EQ REC1 REC2)
(COND
((NOT (ILESSP POS1 POS2))
(* If REC1 and REC2 are same, and POS1 does not precede POS2, return NIL
and do nothing to the buffer.)
(RETURN NIL]
(EDITINSERT NIL REC1 POS1 T)
(* break REC1 at POS1. Now REC1 is the rec immed following the break.
On first inspection this appears to be the rec which starts the chain we
want to return. However, the next insert, which will define the end of the
chain, may have to cons up a new rec and its possible THAT rec is the first
one. In any case, the rec following the one before us right now, will be
the first rec of the chain when we're done. So move REC1 back and remember
that its NEXT is the first rec in our answer chain.)
(SETQ REC1 (fetch TXDTPREV of REC1))
(EDITINSERT NIL REC2 POS2 T)
(* break REC2 at POS2.)
(SETQ LASTREC (fetch TXDTPREV of REC2))
(* we need to save the PREV rec from REC2, because it will be the last rec
in the chain we will return.)
(SETQ REC1 (fetch TXDTNEXT of REC1))
(* Now reset REC1 so that it is first rec in the chain to be grabbed)
(EDITDELETE REC1 POS1 REC2 POS2 COUNTLCFLG)
(* now delete the window. But, REC1 still points to the first deleted rec!)
(/replace TXDTPREV of REC1 with NIL)
(* set PREV of first rec to NIL)
(/replace TXDTNEXT of LASTREC with NIL)
(* and set NEXT of last rec to NIL)
(RETURN REC1])
(EDITGREATERP
[LAMBDA (REC1 POS1 REC2 POS2)
(* goes from REC1,POS1 to REC2,POS2 and if it finds it returns NIL.
If it hits btm first returns T.)
(PROG NIL
[COND
((EQ REC1 REC2) (* if they are the same initially, just
check the POSs)
(RETURN (IGREATERP POS1 POS2]
(* we will loop down thru the NEXT chain of REC1 looking for REC2 and
return T if we don't find it)
LOOP(SETQ REC1 (fetch TXDTNEXT of REC1))
(COND
((EQ REC1 REC2) (* found it, so return NIL)
(RETURN NIL))
((BTMRECP REC1)
(* if we have pushed REC1 to the btm, and haven't hit REC2, then return T)
(RETURN T)))
(GO LOOP])
(EDITINSERT
[LAMBDA (OBJ REC POS COUNTLCFLG)
(* This is the general insert fn. REC,POS is the location at which OBJ is
to be inserted. If OBJ is a grabbed obj it is unmarked and inserted.
If OBJ is NIL, REC is broken at POS but nothing is inserted.
Anything else denotes a file window -- somehow. If OBJ is a list begining
with the value of TXDTINSERTFILEKEY it is taken to be of the form
(TXDTINSERTFILEKEY filename pos1 pos2), where the pos'i default to current
file ptr and eof respectively. If any other list, the elements are prin3d
to the scratchfile and that window inserted. If a non-list, it is prin3d
and inserted. If window is empty or negative, the fn acts as though an
empty insertion were made, but actually does nothing.
If COUNTLCFLG is non-NIL the number of lines/chars in the insertion is
counted and stored in TXDTDELTA. This fn sets the location of the beginning
and end of the insertion in EDITINSERTREC1,EDITINSERTPOS1 and
EDITINSERTREC2,EDITINSRTPOS2.)
(* This function does all the computing it must do to cause errors, and
then enters uninterrupable mode to actually modify the structures
involved.)
(PROG (CHAIN X GRABBEDOBJFLG OLDINTERRUPTABLEVAL)
(* make sure type of args is ok.)
(OR (AND (type? TXDTRECORD REC)
(NOT (ILESSP POS -1500))
(NOT (IGREATERP POS 1060)))
(ERROR "Attempt to use object of wrong type"
(LIST REC POS)))
(* Now we must be sure OBJ is capable of being inserted and cause errors if
its not. If we get out of this COND we will have set CHAIN to the chian of
recs to be inserted.)
[COND
[(type? TXDTGRABBEDOBJ OBJ)
(* OBJ is a grabbed object.
Make sure its ok.)
(COND
[(AND (OR (type? TXDTRECORD (SETQ CHAIN
(fetch TXDTCHAIN of OBJ)))
(STREQUAL CHAIN ""))
(EQ (fetch TXDTGRABFLG of OBJ)
(QUOTE GRABBED))
(MARKEDP CHAIN))
(* The object is a valid grabbed object. Set the flag that says we must
unmark it and sets its TXDTGRABFLG to (QUOTE GRABBED&INSERTED))
(SETQ GRABBEDOBJFLG T)
(COND
((NOT (type? TXDTRECORD CHAIN))
(* In this case, the CHAIN is jst the empty string.
When asked to insert the null string -- as opposed to the specially
recognized chain NIL -- do nothing. return current location.)
(/replace TXDTGRABFLG of OBJ with (QUOTE
GRABBED&INSERTED))
(* tag the object as now being inserted in case someone tries to insert it
again)
(SETQ EDITINSERTREC2 (SETQ EDITINSERTREC1 REC))
(SETQ EDITINSERTPOS2 (SETQ EDITINSERTPOS1 POS))
[COND
(COUNTLCFLG (SETQ TXDTDELTA
(COND
((EQ COUNTLCFLG (QUOTE BOTH))
(CONS 0 0))
(T 0]
(RETURN]
(T (* otherwise, its an object that failed
to meet the standards)
(ERROR (COND
((EQ (fetch TXDTGRABFLG of OBJ)
(QUOTE GRABBED&INSERTED))
"ATTEMPT TO REINSERT INSERTED GRABBED OBJECT")
((EQ (fetch TXDTGRABFLG of OBJ)
(QUOTE GRABBED&UNDONE))
"ATTEMPT TO INSERT THE RESULT OF AN UNDONE GRAB")
(T
"ATTEMPT TO INSERT MYSTERIOUSLY MUNGED GRABBED OBJECT"))
OBJ]
((NULL OBJ) (* just break the record but insert
nothing. Let CHAIN be NIL)
(SETQ CHAIN NIL))
(T
(* The object implicitly represents a file window. If it is of the form
(TXDTINSERTFILEKEY --) we assume it is (TXDTINNERTFILEKEY filename pos1
pos2) and insert that windown. Otherwise we prin3 it to a scratch file and
use that window.)
(PROG (FILE FILEJFN PAGE1 PAGE2 TEMPCHAIN DEFAULTMSG)
[COND
[(AND (LISTP OBJ)
(EQ (CAR OBJ)
TXDTINSERTFILEKEY))
[SETQ FILEJFN
(OPNJFN (INPUT (INFILE (CADR OBJ]
(OR (AND (CADDR OBJ)
(SETN TXDTINSERTFILEPOS1BOX
(CADDR OBJ)))
(SETN TXDTINSERTFILEPOS1BOX
(JSYS 35 FILEJFN NIL NIL 2)))
(OR (AND (CADDDR OBJ)
(SETN TXDTINSERTFILEPOS2BOX
(CADDDR OBJ)))
(SETN TXDTINSERTFILEPOS2BOX
(JSYS 30 FILEJFN NIL NIL 2]
(T
(* If OBJ is anything else, PRIN3 it to the scratchfile.
Lists are printed element wise -- i.e., without the initial and final
parens and spaces.)
(SETQ FILE TXDTSCRATCHFILE)
(SETQ FILEJFN (OPNJFN TXDTSCRATCHFILE))
(JSYS 23 FILEJFN -1)
(SETN TXDTINSERTFILEPOS1BOX
(JSYS 35 FILEJFN NIL NIL 2))
(COND
((LISTP OBJ)
(for X in OBJ do (PRIN3 X TXDTSCRATCHFILE)
))
(T (PRIN3 OBJ TXDTSCRATCHFILE)))
(SETN TXDTINSERTFILEPOS2BOX
(JSYS 35 FILEJFN NIL NIL 2]
(COND
((EQ FILE T)
(ERROR "ATTEMPT TO INSERT A SEGMENT OF FILE T"
OBJ)))
(OR (EQ FILE TXDTSCRATCHFILE)
(MEMB FILE EDITREADFILELST)
(SETQ EDITREADFILELST (CONS FILE
EDITREADFILELST)))
(COND
((NOT (IGREATERP TXDTINSERTFILEPOS2BOX
TXDTINSERTFILEPOS1BOX))
(* if asked to insert the null string -- as opposed to the specially
recognized chain NIL -- do nothing. return current location.)
(SETQ EDITINSERTREC2 (SETQ EDITINSERTREC1 REC))
(SETQ EDITINSERTPOS2 (SETQ EDITINSERTPOS1 POS))
[COND
(COUNTLCFLG (SETQ TXDTDELTA
(COND
((EQ COUNTLCFLG
(QUOTE BOTH))
(CONS 0 0))
(T 0]
(RETURN)))
(* At this point, FILE, FILEPOS1, and TXDTINSERTFILEPOS2BOX are all
correctly set. Now make a chain of recs that represents that window of
file.)
(SETQ PAGE1 (IQUOTIENT TXDTINSERTFILEPOS1BOX 2560))
(SETN TXDTINSERTPOS1BOX (IREMAINDER
TXDTINSERTFILEPOS1BOX
2560))
(* Get page and first character position
of first char)
(SETQ PAGE2 (IQUOTIENT TXDTINSERTFILEPOS2BOX 2560))
(SETN TXDTINSERTPOS2BOX (IREMAINDER
TXDTINSERTFILEPOS2BOX
2560))
(COND
((ZEROP TXDTINSERTPOS2BOX)
(SETQ PAGE2 (SUB1 PAGE2))
(SETN TXDTINSERTPOS2BOX 2560)
(* We know we can step back from PAGE2 since if it were 0, the two FILEPOSs
would both be 0)
)) (* Get page and last char position of
last char)
[SETQ DEFAULTMSG (COND
((IEQP POS (fetch TXDTOFFSET1 of REC))
(fetch TXDTMSG of (fetch TXDTPREV
of REC)))
(T (fetch TXDTMSG of REC]
(COND
((IEQP PAGE1 PAGE2)
(* if only one page, make one rec chain)
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ CHAIN (create TXDTRECORD TXDTSOURCE _(
PACKJFNPG FILEJFN PAGE1)
TXDTOFFSET1 _(IPLUS -1500
TXDTINSERTPOS1BOX)
TXDTOFFSET2 _(IPLUS -1500
TXDTINSERTPOS2BOX)
TXDTPREV _ NIL TXDTNEXT _
NIL TXDTMSG _ DEFAULTMSG))
(RETURN)))
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ CHAIN (create TXDTRECORD TXDTSOURCE _(
PACKJFNPG FILEJFN PAGE2)
TXDTOFFSET1 _ -1500
TXDTOFFSET2 _(IPLUS -1500
TXDTINSERTPOS2BOX)
TXDTPREV _ NIL TXDTNEXT _ NIL
TXDTMSG _ DEFAULTMSG))
LOOP(SETQ PAGE2 (SUB1 PAGE2))
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ TEMPCHAIN
(create TXDTRECORD TXDTSOURCE _(PACKJFNPG
FILEJFN
PAGE2)
TXDTOFFSET1 _(IPLUS
-1500
(OR (AND (IEQP PAGE1 PAGE2)
TXDTINSERTPOS1BOX)
0))
TXDTOFFSET2 _(IPLUS -1500 2560)
TXDTPREV _ NIL TXDTNEXT _ CHAIN TXDTMSG
_ DEFAULTMSG))
(replace TXDTPREV of CHAIN with TEMPCHAIN)
(SETQ CHAIN TEMPCHAIN)
(* This dance with CHAIN and TEMPCHAIN is here to avoid a bug in the record
package that prevents a (replace x of y with (SETQ y --)) in compiled
code.)
(COND
((IEQP PAGE2 PAGE1)
(* if PAGE1 finally done, quit)
(RETURN)))
(GO LOOP]
(* At this point, the flag GRABBEDOBJFLG is set to T iff OBJ is a grabbed
object which we should unmark as part of our inserting.
In any case, CHAIN is either the litatom NIL -- meaning just split REC,POS
-- or it is a chain to be inserted at REC,POS.)
(SETQ EDITINSERTREC1 CHAIN)
(SETQ EDITINSERTPOS1 (AND CHAIN (fetch TXDTOFFSET1
of CHAIN)))
(* save loc of beginning of insertion. We will override this if CHAIN is
NIL once we know the loc of the end.)
(* WE ARE ABOUT TO ENTER THE CRITICAL SECTION OF CODE DURING WHICH WE
ACTUALLY MAKE THE INSERTION. FIRST ENTER NO-INTERRUPT MODE.)
(SETQ OLDINTERRUPTABLEVAL (INTERRUPTABLE NIL))
(* Now unmark the grabbed object and change its TXDTMSG field if a msg
field was specified in OBJ.)
[COND
(GRABBEDOBJFLG (UNMARK CHAIN)
(/replace TXDTGRABFLG of OBJ
with (QUOTE GRABBED&INSERTED]
(COND
[(IEQP POS (fetch TXDTOFFSET1 of REC))
(* if POS is the beginning of REC, just
link, don't split first)
(COND
(CHAIN (* if CHAIN is non-NIL, do it)
(/replace TXDTNEXT of (fetch TXDTPREV
of REC)
with CHAIN)
(replace TXDTPREV of CHAIN
with (fetch TXDTPREV of REC]
(T (* split REC and then add CHAIN)
(SETN TXDTRECORDCNT (ADD1 TXDTRECORDCNT))
(SETQ X (create TXDTRECORD TXDTSOURCE _(fetch TXDTSOURCE
of REC)
TXDTOFFSET1 _(fetch TXDTOFFSET1
of REC)
TXDTOFFSET2 _ POS TXDTPREV _(fetch
TXDTPREV of REC)
TXDTNEXT _(OR CHAIN REC)
TXDTSPLITRECS _ NIL TXDTMSG _(fetch
TXDTMSG of REC)))
(/replace TXDTSPLITRECS of REC
with (NCONC1 (fetch TXDTSPLITRECS of REC)
X))
(/replace TXDTNEXT of (fetch TXDTPREV of REC)
with X)
(COND
(CHAIN (replace TXDTPREV of CHAIN with X))
(T (/replace TXDTPREV of REC with X)))
(/replace TXDTOFFSET1 of REC with POS)))
(COND
(CHAIN (* now link last rec in chain to REC)
(until (NULL (SETQ X (fetch TXDTNEXT of CHAIN)))
do (SETQ CHAIN X))
(/replace TXDTNEXT of CHAIN with REC)
(/replace TXDTPREV of REC with CHAIN)))
(* THIS IS THE END OF THE CRITICAL
SECTION. TURN INTERRUPTS BACK ON.)
(INTERRUPTABLE OLDINTERRUPTABLEVAL)
(SETQ EDITINSERTREC2 REC)
(SETQ EDITINSERTPOS2 (fetch TXDTOFFSET1 of REC))
(* set up loc of end of insertion)
(COND
((NULL CHAIN) (* if chain was empty, reset loc of
beginning to end loc)
(SETQ EDITINSERTREC1 EDITINSERTREC2)
(SETQ EDITINSERTPOS1 EDITINSERTPOS2)))
[COND
((AND TXDTESCAPECHAR (NOT GRABBEDOBJFLG))
(* If TXDTESCAPECHAR is non-NIL, scan inserted text for TXDTESCAPECHAR and
set the msg field of the succeeding chars to the next char.
Also, compute new value of TXDTDELTA.)
(EDITINSERTESCAPE EDITINSERTREC1 EDITINSERTPOS1
EDITINSERTREC2 EDITINSERTPOS2
COUNTLCFLG))
(COUNTLCFLG
(* if we are to count the text inserted, do it -
UNLESS EDITINSERTESCAPE was called, which did it for us!)
(EDITCOUNTLC EDITINSERTREC1 EDITINSERTPOS1
EDITINSERTREC2 EDITINSERTPOS2
(EQ COUNTLCFLG (QUOTE CHARS)))
(SETQ TXDTDELTA (COND
((EQ COUNTLCFLG (QUOTE CHARS))
EDITCOUNTC)
((EQ COUNTLCFLG (QUOTE LINES))
EDITCOUNTL)
(T (CONS EDITCOUNTL EDITCOUNTC]
(RETURN])
(EDITINSERTESCAPE
[LAMBDA (REC1 POS1 REC2 POS2 COUNTLCFLG)
(PROG (JUSTCHARS LASTMSG MSG OLDREC1 OLDPOS1 (FIRSTTIMEFLG T)
SRC OLDFILEPTR (TEMPL 0)
(TEMPC 0))
(SETQ JUSTCHARS (EQ COUNTLCFLG (QUOTE CHARS)))
(SETQ LASTMSG (fetch TXDTMSG of (fetch TXDTPREV of REC1)))
SAVEOLDLOC
(SETQ OLDREC1 REC1)
(SETQ OLDPOS1 POS1)
FINDNEXTESC
(EDITCOUNTLC REC1 POS1 REC2 POS2 JUSTCHARS NIL TXDTESCAPECHAR)
(* Before we bother to check that we actually found an escape char, we must
incrmment our line/char counts)
[COND
(EDITCOUNTSTOPREC
(* if we found an escape char, decrement the char count by 1 because it
includes the escape char itself, which will PROBABLY be deleted.
If not to be deleted, well fix it later.)
(SETQ EDITCOUNTC (SUB1 EDITCOUNTC]
[COND
((EQ COUNTLCFLG (QUOTE CHARS))
(SETN TEMPC (IPLUS TEMPC EDITCOUNTC)))
((EQ COUNTLCFLG (QUOTE LINES))
(SETN TEMPL (IPLUS TEMPL EDITCOUNTL)))
(T (* We must count both)
(SETN TEMPL (IPLUS TEMPL EDITCOUNTL))
(SETN TEMPC (COND
((ZEROP EDITCOUNTL)
(IPLUS TEMPC EDITCOUNTC))
(T EDITCOUNTC]
(COND
((NULL EDITCOUNTSTOPREC)
(* If no escape char was seen we are done. Set up as though we had
previously gone as far as REC2 and then put down the last msg.)
(SETQ EDITDELETEREC REC2)
(GO PUTLASTMSG)))
(EDITMOVEC 1 EDITCOUNTSTOPREC EDITCOUNTSTOPPOS)
(SETQ MSG (EDITCHAR EDITMOVECREC EDITMOVECPOS))
(COND
((EQ MSG 127)
(* If MSG is 127 then we just delete the 127 and leave the esc char.)
(EDITDELETE EDITMOVECREC EDITMOVECPOS EDITCHARREC
EDITCHARPOS)
(* since the escape char isn't being
killed, add it into TEMPC.)
(SETN TEMPC (ADD1 TEMPC)))
((EQ MSG 0)
[SETQ MSG (for I from 1 to MAX
bind (MAX _(EDITCHAR EDITCHARREC EDITCHARPOS)
)
collect (CHARACTER (EDITCHAR EDITCHARREC
EDITCHARPOS]
(EDITDELETE EDITCOUNTSTOPREC EDITCOUNTSTOPPOS EDITCHARREC
EDITCHARPOS))
(T (SETQ MSG (CHARACTER MSG))
(EDITDELETE EDITCOUNTSTOPREC EDITCOUNTSTOPPOS
EDITCHARREC EDITCHARPOS)))
(COND
((AND (EQ EDITCOUNTSTOPREC OLDREC1)
(IEQP EDITCOUNTSTOPPOS OLDPOS1))
(* If the delete just performed removed the first chars of the OLDREC,POS
we are saving, realign it. Note: we can't even be sure that its the same
record now, since the esc char might have been the only char on that
record!)
(SETQ OLDREC1 EDITDELETEREC)
(SETQ OLDPOS1 EDITDELETEPOS))
((EQ OLDREC1 EDITCOUNTSTOPREC)
(* If not first char, but some char of OLDREC1 was deleted, then the rec
was split and we should back up from the current rec.
The pos must be ok, since it must have been the first on the rec and is
thus still valid on the prev rec.)
(SETQ OLDREC1 (fetch TXDTPREV of EDITDELETEREC)))
(T
(* If the esc seq wasn't found on this record, we needn't worry about our
old rec being changed.)
))
(COND
(FIRSTTIMEFLG
(* If this is the first time we have ever done this, then reset
EDITINSERTREC1 , EDITINSERTPOS1 to account for the realignment.)
(SETQ FIRSTTIMEFLG NIL)
(SETQ EDITINSERTREC1 OLDREC1)
(SETQ EDITINSERTPOS1 OLDPOS1)))
(COND
((EQ MSG 127)
(* Now, having accounted for any possible disturbance by deleting those
chars, we now check to see if we are to change to a new msg or not.
If the msg we jsst saw was 127 we should just loop again.)
(SETQ REC1 EDITDELETEREC)
(SETQ POS1 EDITDELETEPOS)
(GO FINDNEXTESC)))
PUTLASTMSG
(* Otherwise, drive OLDREC1 forward until we hit the current position,
settinn the msg field to LASTMSG.)
(COND
((NEQ OLDREC1 EDITDELETEREC)
(replace TXDTMSG of OLDREC1 with LASTMSG)
(SETQ OLDREC1 (fetch TXDTNEXT of OLDREC1))
(GO PUTLASTMSG))
((NULL EDITCOUNTSTOPREC)
[SETQ TXDTDELTA (COND
((EQ COUNTLCFLG (QUOTE CHARS))
TEMPC)
((EQ COUNTLCFLG (QUOTE LINES))
TEMPL)
(T (CONS TEMPL TEMPC]
(RETURN)))
(SETQ LASTMSG MSG)
(SETQ REC1 EDITDELETEREC)
(SETQ POS1 EDITDELETEPOS)
(GO SAVEOLDLOC])
(EDITMAPCHARS
[LAMBDA (REC1 POS1 REC2 POS2 ASCIIFLG BACKWARDS UNTILFN)
(PROG (CC UNTILFLG ACTIVEREC ACTIVEPOS)
(SETQ OLDFLG TXDTRESETFORMBREAKLOCKSFLG)
(SETQ TXDTRESETFORMBREAKLOCKSFLG T)
[COND
[BACKWARDS
(COND
((AND (TOPRECP (fetch TXDTPREV of REC2))
(EQ POS2 (fetch TXDTOFFSET1 of REC2)))
(SETQ EDITCHARREC REC2)
(SETQ EDITCHARPOS POS2))
(T [COND
[(BTMRECP REC2)
(SETQ POS2 (fetch TXDTOFFSET2
of (fetch TXDTPREV of REC2]
(T (SETQ ACTIVEREC (fetch TXDTNEXT of REC2]
(ASSEMBLE NIL
(DCLCONSTS ((BP 0)
(END-BP -1)
(POS -2)))
(PUSHNN (= 0)
(= 0)
(= 0))
(JRST PREVREC)
BACKLOOP
(NREFE (MOVE 2 , BP))
(ADD 2 , = 70000000000Q)
(CAIGE 2 , 0)
(SUB 2 , = -347777777777Q)
(NREFE (CAMN 2 , END-BP))
(JRST PREVREC)
(NREFE (MOVEM 2 , BP))
FETCH
(LDB 1 , 2)
(CQ (LOC (AC)))
(SETQ CC)
(NREFE (SOS POS))
[CQ (OR ASCIIFLG (SETQ CC (CHARACTER
CC)))
(COND
((APPLY* UNTILFN CC)
(SETQ UNTILFLG T)
(JRST FINISHED]
(JRST BACKLOOP)
PREVREC
(CQ (OR POS2 (UNLOCK ACTIVEREC))
(COND
((EQ REC1 ACTIVEREC)
(JRST FINISHED)))
(SETQ ACTIVEREC (fetch TXDTPREV
of ACTIVEREC))
(COND
((TOPRECP ACTIVEREC)
(SETQ ACTIVEREC
(fetch TXDTNEXT of ACTIVEREC))
(JRST FINISHED)))
(SETQ ACTIVEPOS
(OR POS2 (fetch TXDTOFFSET2
of ACTIVEREC)))
(LOADREC ACTIVEREC
(AND (EQ REC1 ACTIVEREC)
POS1)
ACTIVEPOS T)
(SETQ POS2 NIL)
(SETQ ACTIVEPOS (SUB1 ACTIVEPOS))
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(JRST PREVREC)))
(VAG (BYTEPOINTER BASEADDR OFFSET2)))
(NREFE (MOVEM 1 , BP))
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(NREFE (MOVEM 1 , END-BP))
(CQ (VAG ACTIVEPOS))
(NREFE (MOVEM 1 , POS))
(NREFE (MOVE 2 , BP))
(JRST FETCH)
FINISHED
(NREFE (MOVE 1 , POS))
(CQ (LOC (AC)))
(SETQ ACTIVEPOS)
(POPNN 3))
(UNLOCK ACTIVEREC)
(COND
[(ILESSP ACTIVEPOS (fetch TXDTOFFSET1
of ACTIVEREC))
(COND
((TOPRECP (SETQ EDITCHARREC
(fetch TXDTPREV of ACTIVEREC)))
(SETQ EDITCHARREC ACTIVEREC)
(SETQ EDITCHARPOS (fetch TXDTOFFSET1
of EDITCHARREC)))
(T (SETQ EDITCHARPOS
(SUB1 (fetch TXDTOFFSET2 of EDITCHARREC]
(T (SETQ EDITCHARREC ACTIVEREC)
(SETQ EDITCHARPOS ACTIVEPOS]
(T (COND
((BTMRECP REC1)
(SETQ EDITCHARREC REC1)
(SETQ EDITCHARPOS 0))
(T (SETQ ACTIVEREC (fetch TXDTPREV of REC1))
(ASSEMBLE NIL
(DCLCONSTS ((BP 0)
(END-BP -1)
(POS -2)))
(PUSHNN (= 0)
(= 0)
(= 0))
(JRST NEXTREC)
FORWLOOP
(NREFE (ILDB 1 , BP))
(CQ (LOC (AC)))
(SETQ CC)
(NREFE (AOS POS))
[CQ (OR ASCIIFLG (SETQ CC (CHARACTER
CC)))
(COND
((APPLY* UNTILFN CC)
(SETQ UNTILFLG T)
(JRST FINISHED]
(NREFE (MOVE 1 , BP))
(NREFE (CAME 1 , END-BP))
(JRST FORWLOOP)
NEXTREC
(CQ (OR POS1 (UNLOCK ACTIVEREC))
(COND
((EQ ACTIVEREC REC2)
(JRST FINISHED)))
(SETQ ACTIVEREC
(fetch TXDTNEXT of ACTIVEREC))
(COND
((BTMRECP ACTIVEREC)
(JRST FINISHED)))
(SETQ ACTIVEPOS
(OR POS1 (fetch TXDTOFFSET1
of ACTIVEREC)))
(LOADREC ACTIVEREC ACTIVEPOS
(AND (EQ ACTIVEREC REC2)
POS2)
T)
(SETQ POS1 NIL)
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(JRST NEXTREC)))
(VAG (BYTEPOINTER BASEADDR OFFSET1)))
(NREFE (MOVEM 1 , BP))
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET2)))
(NREFE (MOVEM 1 , END-BP))
(CQ (VAG ACTIVEPOS))
(NREFE (MOVEM 1 , POS))
(JRST FORWLOOP)
FINISHED
(NREFE (MOVE 1 , POS))
(CQ (LOC (AC)))
(SETQ ACTIVEPOS)
(POPNN 3))
(UNLOCK ACTIVEREC)
(COND
((NOT (ILESSP ACTIVEPOS (fetch TXDTOFFSET2
of ACTIVEREC)))
(SETQ EDITCHARREC (fetch TXDTNEXT of ACTIVEREC))
(SETQ EDITCHARPOS (fetch TXDTOFFSET1
of EDITCHARREC)))
(T (SETQ EDITCHARREC ACTIVEREC)
(SETQ EDITCHARPOS ACTIVEPOS]
(SETQ TXDTRESETFORMBREAKLOCKSFLG OLDFLG)
(RETURN UNTILFLG])
(EDITMKSTRING
[LAMBDA (REC1 POS1 REC2 POS2 DONTCOPY TEMPSTR1 STRPTR BITMASK)
(* makes a string out of the given window, translating CR/LF into EOL.
If DONTCOPY is on the string returned will be a substring of the buffer
(TEMPSTR1) used to assemble all of the chars in the window.
In any case, STRPTR, if it is a string pointer, will be smashed to
represent the new string. Skips any char with its bit on in BITMASK.)
(PROG (FULLBUFLST MSG LASTMSG NCHARSTEMPSTR1)
(COND
((BTMRECP REC1) (* if we are already at the btm, quit
with empty string)
(RETURN "")))
(SETQ NCHARSTEMPSTR1 (NCHARS TEMPSTR1))
(OR BITMASK (SETQ BITMASK 0))
(SETQ REC1 (fetch TXDTPREV of REC1))
(* tactical retreat to prepare for first rec step taken at NEXTREC to load
the first rec.)
(ASSEMBLE NIL
TOP
(* An outline: We will accomplish this feat by moving bytes from the text
of the recs in the window to a buffer call TEMPSTR1 of length
NCHARSTEMPSTR1. AC1 will hold the bp into this buffer, and AC2 the total
number of free spaces remaining in the buffer. Each time we write a char
into it we will decrmt AC2. Whenever it becomes zero we'll jump off to
EMPTYBUF, copy the buffer into a new string, nconc that string onto the
list FULLBUFLST and then refresh AC1 and 2 with their initial values.
If the string TEMPSTR1 is sufficiently long we won't have to copy it often.
AC3 and AC4 will be used to hold the start and end bps for the window into
the current rec. When they become equal we will jump off to NEXTREC to
step. Eventually, when we have copied what turns out to be the last rec, we
will not return from this jump.)
(DCLCONSTS ((MASK -6)
(EMPTYBUF-RETURN-LINK -5)
(NEXTREC-RETURN-LINK -4)
(SAVE-AC1 -3)
(SAVE-AC2 -2)
(SAVE-AC3 -1)
(SAVE-AC4 0)))
(PUSHNN (= 0)
(= 0)
(= 0)
(= 0)
(= 0)
(= 0)
(= 0)) (* We will need to save ACs at both
EMPTYBUF and NEXTREC)
(CQ (VAG BITMASK))
(NREFE (MOVEM 1 , MASK))
(CQ (VAG NCHARSTEMPSTR1))
(PUSHN 1)
(CQ (VAG (BYTEPOINTER (STRINGBASE TEMPSTR1)
OFFSET1)))
(POPN 2) (* now AC1 and AC2 are set as described
above)
(JSP 6 , NEXTREC) (* go load the first rec and return
here)
FETCHBYTE
(ILDB 5 , 3)
(NREFE (MOVE 6 , MASK))
(* Move mask into 6 so we can shift it.)
(LSH 6 , @ 5) (* shift it by byte and see if the bytes
bit is on.)
(TLNE 6 , 400000Q)
(* if bit is on, skip all deposit
stuff.)
(JUMPA CHKEND) (* fetch next byte from current window)
(CAIN 5 , 15Q) (* see if it is a CR)
(JUMPA CHKCRLF)
(* if so, go see if its a CR/LF pair and return to next instr with whatever
char we are to copy in AC5. May be CR if this is a lone CR, and may be
EOL.)
DEPOSITBYTE
(IDPB 5 , 1) (* write the byte now in AC5 into the
buffer)
(SOSN 2)
(JSP 6 , EMPTYBUF)
(* decrmt buf space count and if zero go
empty buffer)
CHKEND (* now see if we are at the end of the
window)
(CAMN 3 , 4) (* compare bps)
(JSP 6 , NEXTREC)
(* if so, go step to next rec. Note that we may not return from this jump
if this was the last rec!)
(JUMPA FETCHBYTE) (* keep looping)
CHKCRLF
(* we get here if we fetched a CR. We want to know if there is a LF
following it.)
(CAMN 3 , 4) (* can we fetch another byte?)
(JUMPA STICKY)
(* if not we have a slightly sticky situation: we need to step to the next
rec. But maybe this one is the last one. If so, jumping off to NEXTREC
wouldn't return. But we need to write this last byte out, assuming its a
lone CR since we can't look beyond it. What to do? Let STICKY handle it.)
CHKLF (* if we can fetch another byte)
(ILDB 5 , 3)
(* mung AC5 with it. We know there was a CR in it if we need to "undo" this
-- ie, if this new byte isn't a LF)
(CAIN 5 , 12Q) (* see if new byte is LF)
(JUMPA CRLF) (* yes! Whew, now go pretend we really
saw a EOL)
(ADD 3 , = 70000000000Q)
(* we are in another slightly sticky situation: we have taken the liberty
to read another byte hoping it would be a LF. It wasn't.
We must now go write that CR we saw that triggered this, and then resume
processing whatever we just fetched. The easiest thing to do is to back up
the bp in AC3 and just reread this when the time comes.)
(CAIGE 3 , 0)
(SUB 3 , = -347777777777Q)
(MOVEI 5 , 15Q) (* now put that CR back into AC5)
(JUMPA DEPOSITBYTE)
(* and go deposit this byte as though
nothing ever happened...)
CRLF
(* we get here if we indeed have hit a CR/LF. Pretend it was an EOL and
proceed normally)
(MOVEI 5 , 37Q)
(JUMPA DEPOSITBYTE)
STICKY
(* we get here is we have a CR in AC5 and want to see if a LF follows it,
but it is on the edge of its rec. We will go ahead an write a CR into the
buffer so that if this is the last rec it will be there.
We will also decrmt the count in AC2. However we will not check to see if
this zeroes the count, since we don't want to go copy this buffer only to
find a LF does follow this in the next rec and have to undo the copy too!
Then we'll pushj off to NEXTREC to get the next rec.
Now if that comes back, we will back up the bp into the buffer and add one
to the count, undo our preparations for the end. And then return to CHKLF
where we see what follows the CR. But if we don't return from NEXTREC then
the buffer will be in a slightly funny state: there will be no room in it
but it will not have been emptied. This is not possible were it not for
this singular occurrence. But the code that constructs our final answer
from FULBUFFLST, AC2, and TEMPSTR1 knows that AC2 might be zero.
So, we're off!)
(IDPB 5 , 1)
(SUBI 2 , 1) (* ok, we are ready to JSP)
(JSP 6 , NEXTREC) (* here's hoping we come back)
(ADD 1 , = 70000000000Q)
(* horray! now back up)
(CAIGE 1 , 0)
(SUB 1 , = -347777777777Q)
(ADDI 2 , 1) (* so now its as though we didn't write
anything)
(JUMPA CHKLF) (* and we can go see about that LF)
EMPTYBUF
(* we get here if the count in AC2 has been zeroed, that is, we are out of
buffer space)
(SUBI 6 , TOP)
(NREFE (MOVEM 6 , EMPTYBUF-RETURN-LINK))
(NREFE (MOVEM 3 , SAVE-AC3))
(* we will use LISP to save the buffer so protect AC3 and AC4 since they
hold bps not relevant to the buffer. AC5 has a char in it which we've just
written to the buffer, and AC1 and AC2 must be refreshed after emptying the
buffer.)
(NREFE (MOVEM 4 , SAVE-AC4))
(CQ (SETQ FULLBUFLST (NCONC1 FULLBUFLST
(CONCAT TEMPSTR1)))
(VAG NCHARSTEMPSTR1))
(PUSHN 1) (* push the free space count for a
moment)
(CQ (VAG (BYTEPOINTER (STRINGBASE TEMPSTR1)
OFFSET1)))
(* put the bp to the beginning of the
buffer in AC1)
(POPN 2) (* put the count into AC2)
(NREFE (MOVE 4 , SAVE-AC4))
(NREFE (MOVE 3 , SAVE-AC3))
(* restore the windowing bps)
(NREFE (MOVE 6 , EMPTYBUF-RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6)
(* and return to the main loop, which is the only place which calls
EMPTYBUF.)
NEXTREC
(* we get here if its time to step to a new rec. We do this in LISP.
So we want to save AC1 and AC2 since they have our buffer info in them.)
(SUBI 6 , TOP)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
(NREFE (MOVEM 6 , NEXTREC-RETURN-LINK))
NEXTREC+2
(* if we ever have to skip a rec because the offsets are crossed we loop
thru here rather than NEXTREC to avoid pushing again.)
[CQ (COND
((EQ REC1 REC2)
(* if we are done, quit)
(JRST FINISHED)))
(SETQ REC1 (fetch TXDTNEXT of REC1))
(COND
((BTMRECP REC1)
(* if hit btm, quit)
(JRST FINISHED)))
(COND
((AND TXDTESCAPECHAR (SETQ MSG
(fetch TXDTMSG of REC1))
(NEQ MSG LASTMSG))
(SETQ LASTMSG MSG)
(JRST WRITEMSG))
(T (JRST SKIPMSG]
WRITEMSG
(CQ
[SETQ MSG
(COND
((LISTP MSG)
(RPLACA
[RPLACD
(QUOTE (ZERO . CDR))
(RPLACA (RPLACD (QUOTE (LENGTH . MSG))
MSG)
(CHARACTER (LENGTH MSG]
TXDTCHARACTER0))
(T (RPLACA (QUOTE (MSG))
MSG]
(SETQ MSG
(RPLACA (RPLACD (QUOTE (% % % R O M A N))
MSG)
TXDTESCAPECHAR)))
MSGLOOP
[CQ (VAG (CHCON1 (CAR MSG]
(MOVE 5 , 1)
(NREFE (MOVE 1 , SAVE-AC1))
(NREFE (MOVE 2 , SAVE-AC2))
(IDPB 5 , 1)
(SOSN 2)
(JSP 6 , EMPTYBUF)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
[CQ (COND
((LISTP (SETQ MSG (CDR MSG)))
(JRST MSGLOOP]
SKIPMSG
(CQ (LOADREC REC1 (OR POS1 (fetch TXDTOFFSET1
of REC1))
(AND (EQ REC1 REC2)
POS2))
(SETQ POS1 NIL)
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(* if the offsets are screwed, skip rec
-- probably at end now)
(JRST NEXTREC+2)))
(VAG (BYTEPOINTER BASEADDR OFFSET2)))
(PUSHN 1) (* push it)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(* construct init bp)
(MOVE 3 , 1) (* move it to AC3)
(POPN 4) (* and put end bp into AC4)
(NREFE (MOVE 2 , SAVE-AC2))
(NREFE (MOVE 1 , SAVE-AC1))
(* restore ACs 1 and 2 to their
respective counts)
(NREFE (MOVE 6 , NEXTREC-RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6) (* and return from whence we came)
FINISHED
(* ok, we have done the last rec! Now lets slip into something more
comfortable, but first package up AC2 for outside use.
Put it in POS1 since we don't care about it anymore.)
(NREFE (MOVE 1 , SAVE-AC2))
(CQ (LOC (AC)))
(SETQ POS1)
(POPNN 7) (* clear the stack)
)
(* we get here when we have copied the whole thing into as many bufferfuls
as it takes. The first N-1 buffers are on the list FULLBUFLST, and the real
buffer TEMPSTR1 has the remaining chars in it, with the last POS1 of them
junk.)
(SETQ POS1 (IDIFFERENCE NCHARSTEMPSTR1 POS1))
(* calc the number of chars written into the buff in the last copy)
(RETURN (COND
[FULLBUFLST
(* if more than one buffers worth was written, concat them all, including
the initial part of the current one. Note that we cannot avoid copying here
so DONTCOPY isn't even inspected)
(APPLY (FUNCTION CONCAT)
(COND
((ZEROP POS1)
(* if no chars were written into final
buffer, ignore it)
FULLBUFLST)
(T (NCONC1 FULLBUFLST
(SUBSTRING TEMPSTR1
1 POS1
STRPTR]
((ZEROP POS1) (* if no chars copied, return null
string)
"")
(DONTCOPY
(* if only one buffers worth was copied and we needn't copy it, just return
the substring from the buffer)
(SUBSTRING TEMPSTR1 1 POS1 STRPTR))
(T (* if we are to copy, then do it)
(CONCAT (SUBSTRING TEMPSTR1 1 POS1 STRPTR])
(EDITMOVE
[LAMBDA (LINEDIST CHARDIST REC POS FLG)
(* moves LINEDIST lines and then CHARDIST chars from REC,POS and returns
resulting address. If LINEDIST is 0 it means move to beginning of current
line. If LINEDIST is NIL it means make no line move and proceed with
character move. If CHARDIST is NIL it is assumed to be 0.0 If move exceeds
buffer bounds, return NIL when FLG is set. Answer returned in
EDITMOVECREC,EDITMOVECPOS. NOTE: EDITMOVEC<---!)
(PROG (BACKWARDS)
(COND
((NULL LINEDIST)
(* if no line move to be made, proceed with char move by setting globals as
if line move had been done)
[SETQ EDITMOVELREC (COND
(REC (SETQ EDITMOVELPOS POS)
REC)
(T (ERROR
"INTERNAL TXDT ERROR - SOMEBODY CALLED EDITMOVE WITH NULL REC"]
(GO CHARMOVE))
((ILESSP LINEDIST 1)
(* if LINEDIST is negative or zero, set it to the number of crs to be moved
past backwards before moving forward over the last one.)
(SETQ LINEDIST (ADD1 (IMINUS LINEDIST)))
(SETQ BACKWARDS T)))
(COND
((NULL REC)
(ERROR
"INTERNAL TXDT ERROR - SOMEBODY CALLED EDITMOVE WITH NULL REC")))
(EDITMOVEL LINEDIST REC POS BACKWARDS FLG)
(* move over the required no of crs in the approp direction and set
EDITMOVELREC,EDITMOVELPOS to the location immed behind the last one.)
CHARMOVE (* now make the character move)
(COND
((OR (ZEROP CHARDIST)
(NULL CHARDIST)
(NULL EDITMOVELREC)) (* if no char move necessary, or if line
move unsuccessful, skip it)
(SETQ EDITMOVECREC EDITMOVELREC)
(SETQ EDITMOVECPOS EDITMOVELPOS))
(T (EDITMOVEC (ABS CHARDIST)
EDITMOVELREC EDITMOVELPOS (MINUSP CHARDIST)
FLG)))
(RETURN])
(EDITMOVEC
[LAMBDA (CHARCNT REC POS BACKWARDS FLG)
(* moves CHARCNT chars in the obvious direction from REC,POS.
CR-LF is counted as two chars, and so is EOL! When moving over file recs we
assume no EOLs occur and just arithmetic. When moving over string recs we
actually go thru them char by char and look for the EOLs.
Resulting location is found in EDITMOVECREC,EDITMOVECPOS.
If buffer bounds exceeded and FLG is T, EDITMOVECREC is set to NIL.)
(PROG NIL
(SETQ FINDNCHARSNLEFT CHARCNT)
(* FINDNCHARSNLEFT is the global used by the routine which plods thru text
sequences counting the chars off -- EOLs two at a time.
This global is set to be the number of chars left to find after any given
sequence has been scanned. Inialize it to the total number of chars to
find.)
(COND
(BACKWARDS (GO BACKWARDS)))
FORWARDS
(COND
((BTMRECP REC)
(COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!)))
(SETQ EDITMOVECREC (COND
(FLG NIL)
(T (SETQ EDITMOVECPOS 0)
REC)))
(RETURN)))
[COND
((ILESSP (IPLUS POS FINDNCHARSNLEFT)
(fetch TXDTOFFSET2 of REC))
(* if we can move forward the right no of cars without running off end, do
it)
(SETQ EDITMOVECPOS (IPLUS FINDNCHARSNLEFT POS))
(GO CHECKBOUNDS))
(T (* otherwise it isnt long enough, so
decrement FINDNCHARSNLEFT)
(SETQ FINDNCHARSNLEFT
(IPLUS FINDNCHARSNLEFT POS
(IMINUS (fetch TXDTOFFSET2 of REC]
(SETQ REC (fetch TXDTNEXT of REC))
(* and step to next rec and loop)
(SETQ POS (fetch TXDTOFFSET1 of REC))
(GO FORWARDS)
BACKWARDS (* this is the backwards version of the
loop above)
(COND
((TOPRECP REC)
[COND
(FLG (COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!)))
(SETQ EDITMOVECREC NIL)
(SETQ EDITMOVECPOS 0))
(T (SETQ EDITMOVECREC (fetch TXDTNEXT of REC))
(SETQ EDITMOVECPOS (fetch TXDTOFFSET1 of
EDITMOVECREC]
(RETURN)))
[COND
((NOT (ILESSP (IDIFFERENCE POS FINDNCHARSNLEFT)
(fetch TXDTOFFSET1 of REC)))
(* if we can back up the required
distance, do it)
(SETQ EDITMOVECPOS (IDIFFERENCE POS FINDNCHARSNLEFT))
(GO CHECKBOUNDS))
(T (* otherwise not long enough, so
decrement FINDNCHARSNLEFT)
(SETQ FINDNCHARSNLEFT (IPLUS FINDNCHARSNLEFT
(fetch TXDTOFFSET1
of REC)
(IMINUS POS]
(SETQ REC (fetch TXDTPREV of REC))
(SETQ POS (fetch TXDTOFFSET2 of REC))
(GO BACKWARDS)
CHECKBOUNDS
(* it is possible in the above that we have moved to the very end of REC1,
that is, at -- hopefully not beyond! -- OFFSET2. Check for this and move to
NEXT rec if needed.)
[COND
((NOT (ILESSP EDITMOVECPOS (fetch TXDTOFFSET2 of REC)))
(SETQ REC (fetch TXDTNEXT of REC))
(SETQ EDITMOVECPOS (fetch TXDTOFFSET1 of REC]
(* We must now be sure we havent split a
CR/LF)
(COND
((EDITUNSPLITCRLF REC EDITMOVECPOS BACKWARDS)
(* If so, set up our answer globals to
the unsplit location)
(SETQ EDITMOVECPOS EDITCHARPOS)
(SETQ EDITMOVECREC EDITCHARREC))
(T
(* If not, set our answer globals to the current location, noting that
TXDTMOVECPOS is already set.)
(SETQ EDITMOVECREC REC)))
(* Finally, we must be sure we haven't exceeded buffer bounds if that is
required.)
[COND
(FLG (COND
[(BTMRECP EDITMOVECREC)
(COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!))
(T (SETQ EDITMOVECREC NIL]
((TOPRECP EDITMOVECREC)
(COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!))
(T (SETQ EDITMOVECREC (fetch TXDTNEXT
of EDITMOVECREC))
(SETQ EDITMOVECPOS (fetch TXDTOFFSET1
of EDITMOVECREC]
(RETURN])
(EDITMOVEL
[LAMBDA (LINECNT REC POS BACKWARDS FLG)
(* moves LINECNT lines from REC,POS, backwards if BACKWARDS is T.
Sets up behind the final lf. Always assumes LINENO is greater than 0;
If FLG is T and it exceeds buffer bounds, returns NIL in EDITMOVELREC)
[SETQ POS (COND
(BACKWARDS (EDITSEARCH "
" (QUOTE DUMMYREC)
(QUOTE DUMMYPOS)
REC POS T LINECNT))
(T (EDITSEARCH "
" REC POS (QUOTE DUMMYREC)
(QUOTE DUMMYPOS)
NIL LINECNT] (* NOTE THAT POS HAS BEEN MUNGED BY THIS
ASSIGNMENT!!!)
(COND
(POS (* if search succeeded, set up at
appropriate point)
(COND
((AND (EQ FLG (QUOTE BOUNDARYERR))
(BTMRECP EDITSEARCHREC2))
(ERROR!)))
(SETQ EDITMOVELREC EDITSEARCHREC2)
(SETQ EDITMOVELPOS EDITSEARCHPOS2))
([AND FLG (NOT (AND BACKWARDS (EQ TXDTFINDCNT (SUB1 LINECNT]
(* if not enough lines available and
supposed to fail do it)
(COND
((EQ FLG (QUOTE BOUNDARYERR))
(ERROR!)))
(SETQ EDITMOVELREC NIL)
(SETQ EDITMOVELPOS 0))
(BACKWARDS
(* If soft failure and going backwards, set up at top.
It is assumed that EDITSEARCH leaves EDITSEARCHREC2 at the toprec for this
buffer in the case of a backwards search that fails because it hit the
top.)
(SETQ EDITMOVELREC (fetch TXDTNEXT of EDITSEARCHREC2))
(SETQ EDITMOVELPOS (fetch TXDTOFFSET1 of EDITMOVELREC))
)
(T
(* otherwise, set up at btm. As noted above, if search fails forward and
hits btm we assume EDITSEARCHREC2 is set to btmrec for this buffer.)
(SETQ EDITMOVELREC EDITSEARCHREC2)
(SETQ EDITMOVELPOS 0])
(EDITPRINT
[LAMBDA (REC1 POS1 REC2 POS2 PTRRECPOSLST PTRCHARS DESTJFN BITMASK)
(* prints the chars in the window REC1,POS1 to REC2,POS2 to DESTJFN. PTRRECPOSLST is a list of rec,pos pairs in
ascending order. When one of them is encountered along the way and TXDTPTRCHAR is non-NIL, print the pointer char at
that position. Aside from the pointer, the difference between EDITPRINT and EDITWRITE is that this fn uses BOUTs
while the other PMAPs. CR/LF is written as EOL. Also, call TXDTPRINTUSERFN on the contents of the TXDTMSG field of
every rec encountered -- unless the contents of that field is eq to the last such field seen this time.
Will not print any char, c, if cth bit in bitmask is 1, counting from left at 0 -- normal dec convention.)
(PROG (POS12 (LASTCHARCODE 0)
MSG LASTMSG)
(* We will loop thru the recs, using PRINTSEG to print each segment. We will handle the printing of the ptr char
here with a PRIN1 to the appropriate file.)
(OR BITMASK (SETQ BITMASK 0))
TOP (SETQ MSG (fetch TXDTMSG of REC1))
(COND
((BTMRECP REC1)
(RETURN LASTCHARCODE)))
[SETQ POS12 (COND
((EQ REC1 REC2)
POS2)
(T (fetch TXDTOFFSET2 of REC1]
PTRLOOP
[COND
((AND PTRRECPOSLST (EQ REC1 (CAAR PTRRECPOSLST))
(NOT (IGREATERP POS1 (CDAR PTRRECPOSLST)))
(ILESSP (CDAR PTRRECPOSLST)
POS12)) (* if a PTRREC,PTRPOS is in this segment, and we are
supposed to take special action for the pointer, print
the pointer)
[COND
((ILESSP POS1 (CDAR PTRRECPOSLST)) (* If this is so, then we will actually print a
character. So eval MSG if necessary, before doig it.)
(COND
((AND TXDTESCAPECHAR MSG (NEQ MSG LASTMSG))
(SETQ LASTMSG MSG)
[COND
(TXDTPRINTUSERFNBOX (SETQ TXDTPRINTUSERFNBOX (TXDTBOXRECPOS REC1 POS1
TXDTPRINTUSERFNBOX]
(SETQ MSG (TXDTPRINTUSERFN MSG DESTJFN))
(* If TXDTPRINTUSERFN returned anything other than NIL and it is different from what was there, smash the msg field
of the current rec with the new msg.)
(COND
((AND MSG (NEQ MSG LASTMSG))
(/REPLACE TXDTMSG OF REC1 WITH MSG)
(SETQ LASTMSG MSG)))
(SETQ MSG NIL)))
(SETQ LASTCHARCODE (PRINTSEG REC1 POS1 (CDAR PTRRECPOSLST)
DESTJFN BITMASK]
(PRIN1 (OR (AND (LISTP PTRCHARS)
(OR (PROG1 (CAR PTRCHARS)
(SETQ PTRCHARS (CDR PTRCHARS)))
TXDTPTRCHAR ""))
PTRCHARS TXDTPTRCHAR "")
(OR (EQ DESTJFN 65)
(JFNS DESTJFN))) (* use PRIN1 to print ptr to appropriate file name)
(SETQ POS1 (CDAR PTRRECPOSLST))
(SETQ PTRRECPOSLST (CDR PTRRECPOSLST))
(GO PTRLOOP))
((ILESSP POS1 POS12) (* We will actually print a char, so eval MSG if
necessary.)
(COND
((AND TXDTESCAPECHAR MSG (NEQ MSG LASTMSG))
(SETQ LASTMSG MSG)
[COND
(TXDTPRINTUSERFNBOX (SETQ TXDTPRINTUSERFNBOX (TXDTBOXRECPOS REC1 POS1
TXDTPRINTUSERFNBOX]
(SETQ MSG (TXDTPRINTUSERFN MSG DESTJFN))
(COND
((AND MSG (NEQ MSG LASTMSG))
(/replace TXDTMSG of REC1 with MSG)
(SETQ LASTMSG MSG)))
(SETQ MSG NIL)))
(SETQ LASTCHARCODE (PRINTSEG REC1 POS1 POS12 DESTJFN BITMASK]
(* print relevant window)
(COND
((EQ REC1 REC2)
(RETURN LASTCHARCODE)))
(SETQ REC1 (fetch TXDTNEXT of REC1))
(SETQ POS1 (fetch TXDTOFFSET1 of REC1))
(GO TOP])
(EDITPUTMSG
[LAMBDA (REC POS MSG)
(PROG (OLDMSG)
(COND
([OR (EQ MSG 0)
(COND
((LISTP MSG)
(OR [for TAIL on MSG
thereis (OR (NEQ 1 (NCHARS (CAR TAIL)))
(AND (NLISTP (CDR TAIL))
(CDR TAIL]
(IGREATERP (LENGTH MSG)
127)))
((NULL MSG)
NIL)
(T (NEQ 1 (NCHARS MSG]
(ERROR "ATTEMPT TO INSERT ILLEGAL MESSAGE!" MSG)))
(COND
((NOT (IEQP POS (fetch TXDTOFFSET1 of REC)))
(EDITINSERT NIL REC POS)
(SETQ REC EDITINSERTREC2)))
(SETQ OLDMSG (fetch TXDTMSG of REC))
(/replace TXDTMSG of REC with MSG)
(RETURN OLDMSG])
(EDITRESETSAVEFN
[LAMBDA NIL
(AND RESETSTATE (RESETUNDO OLDVALUE])
(EDITSEARCH
[LAMBDA (STR REC1 POS1 REC2 POS2 BACK COUNT)
(* This is the search function. If finds the COUNTth occurrence of STR in the window. Goes BACKwards from REC2,POS2
if BACK is T. T is returned if we win, NIL otherwise. When T, EDITSEARCHREC1,EDITSEARCHPOS1 and
EDITSEARCHREC2,EDITSEARCHPOS2 will be set to the obvious locations. The general scheme is as follows: The search has
two modes, FINDFIRST and FINDREST. The first is looking for the first char, backwards or forwards.
For speed, this is broken into four different cases: forward for a non-EOL, forward for EOL, backward for non-EOL,
and backward for EOL. Each is coded separately. The stack position named DISPATCHER has a number 2 to 5 in it to
code this breakdown. When the first char is found, we switch to FINDREST mode. This involves saving sufficient ACs
and vars to restart the FINDFIRST mode should we have to, and then setting up the ACs for the second loop.
The record stepping is done by NEXTREC or PREVREC depending on dir desired. When in FINDFIRST mode and we step to a
rec, we lock it when loading since we will probably come back to it. Note that if BACK is T we search backwards only
during FINDFIRST mode. FINDREST always goes forward. During the search, EDITSEARCHREC2 is always the record we are
currently processing. EDITSEARCHPOS2 is always the OFFSET1 pos withwhich it was loaded. When we find the first char
we must save these to restore them should we fail, and to calc the EDITSEARCHREC1,EDITSEARCHPOS1 should we win.
We store them in EDITSEARCHREC1 and EDITSEARCHPOS1. Note that EDITSEARCHREC1 will therefore be correctly set when we
win. But EDITSEARCHPOS1 will not be, it will just the the beginning pos of the rec we loaded, not the pos of the
char found. When we win, EDITSEARCHREC2 will be correctly set, but EDITSEARCHPOS2 will have to be calc.
These are assumed to be globals. They are occassionally referenced directly with HRRMs indirects.
The code is sparsely commented because it is damn hard to read this much LAP with bunches of comments in it.)
(SETQ TXDTRESETFORMBREAKLOCKSFLG T)
(TXDTBREAKLOCKS)
[SETQ BACK (PROG NIL
(OR COUNT (SETQ COUNT 1))
(SETQ EDITSEARCHREC1 (SETQ EDITSEARCHREC2 (OR (AND BACK REC2)
REC1)))
(SETQ EDITSEARCHPOS2 (OR (AND (EQ EDITSEARCHREC2 REC1)
POS1)
(fetch TXDTOFFSET1 of EDITSEARCHREC2)))
(COND
((OR (ZEROP (NCHARS STR))
(ILESSP COUNT 1))
(SETQ TXDTFINDCNT COUNT)
(SETQ EDITSEARCHREC1 EDITSEARCHREC2)
(SETQ EDITSEARCHPOS1 EDITSEARCHPOS2)
(RETURN T))
((AND (NOT BACK)
(BTMRECP EDITSEARCHREC2))
(SETQ TXDTFINDCNT 0)
(RETURN NIL)))
(SETQ FINDFIRSTMODE T)
(RETURN (ASSEMBLE NIL
TOP (DCLCONSTS ((RETURN-LINK -15Q)
(SAVE-AC4 -14Q)
(SAVE-AC3 -13Q)
(FINDCOUNT -12Q)
(STRENDBP -11Q)
(STRINITBP -10Q)
(FIRSTCHAR -7)
(DISPATCHER -6)
(SAVE-AC1 -5)
(SAVE-AC2 -4)
(SAVECURINITBP -3)
(SAVECURENDBP -2)
(CURINITBP -1)
(CURENDBP 0)))
(* These slots will have the following things in them: RETURN-LINK = return link for record steppers.
We don't use a PUSHJ because it mungs CP and we have all these slots on CP. SAVE-AC4 = used to protect AC4 from
NEXTREC. SAVE-AC3 = used to protect AC3 from NEXTREC. FINDCOUNT = number of occurrences left to find.
STRENDBP = end bp for STR. STRINITBP = init bp pointing to char after first. FIRSTCHAR = first char of STR.
DISPATCHER = code 1 to 4 indicating which find first case we use. SAVE-AC1 = holds AC1 when first char is found,
will point to beginning of STR if successful and shows us where to resume if not. SAVE-AC2 = AC2 when first char
found; will hold right limit of that rec during forw search and left limit during back search;
used only for restarting. SAVECURINITBP = CURINITBP for rec on which first char found; used to calc displ of winning
char from beginning; always has left bp in it, even for backward search. SAVECURENDBP = like SAVECURINITBP for
CURENDBP. CURINITBP = left hand bp for current rec -- EDITSEARCHREC2. CURENDBP = right hand bp for current rec.)
(PUSHNN (1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1)
(1))
(CQ (VAG COUNT))
(NREFE (MOVEM 1 , FINDCOUNT))
(CQ (SETQ BASEADDR (STRINGBASE STR))
(VAG (BYTEPOINTER BASEADDR OFFSET2)))
(NREFE (MOVEM 1 , STRENDBP))
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(ILDB 3 , 1)
(NREFE (MOVEM 1 , STRINITBP))
(NREFE (MOVEM 3 , FIRSTCHAR))
(CQ BACK)
(MOVEI 4 , 2)
(CAMN 1 , KT)
(MOVEI 4 , 4)
(CAIN 3 , 37Q)
(ADDI 4 , 1)
(* at this point AC4 is 2 if we are going forward for a non-CR, 3 forward for CR, 4 backward for non-CR, 5 backward
for CR. The reason we use 2-5 rather than 0-3 or 1-4 is so that we can write (ADDI 4 , *) (JUMPA @ 4) since we can't
use indexed jumps. The * being one instr before the JUMPA makes life that much harder.)
(NREFE (MOVEM 4 , DISPATCHER))
(MOVEI 6 , INIT-RETURN)
(* We are about to jump to the routine which load recs. We will avoid the first half of it, which steps recs.
Normally, the entry to this routine is via a JSP on AC6, and the routine saves the return link on the stack and then
JUMPAs @ thru it to return. We must set up the stack appropriately for this...so we put the return address in AC6,
and now move it to the stack slot provided)
(SUBI 6 , TOP)
(NREFE (MOVEM 6 , RETURN-LINK))
(CAMN 1 , KNIL)
(JUMPA LOADRECFORW)
(JUMPA LOADRECBACK)
INIT-RETURN
(NREFE (MOVE 3 , FIRSTCHAR))
(MOVEI 4 , 0)
(* We are ready to go finally. AC1 has the bp from which we will fetch. It will be left hand one for forwards, and
right hand one for backwards. AC2 has other bp. AC3 has first char. AC4 has in 0 it. For an explanation read the
comments at SAVECRRESTART and SAVERESTART.)
(NREFE (MOVE 6 , DISPATCHER))
(ADDI 6 , *)
(JUMPA @ 6)
(JUMPA FIRSTFORWARD)
(JUMPA FIRSTFORWARDCR)
(JUMPA FETCHBACK)
(JUMPA FETCHBACKCR)
FIRSTFORWARD
(ILDB 5 , 1)
(CAMN 3 , 5)
(JUMPA SAVERESTART)
FIRSTCHKENDFORW
(CAMN 1 , 2)
(JSP 6 , NEXTREC)
(JUMPA FIRSTFORWARD)
FIRSTFORWARDCR
(ILDB 5 , 1)
(CAIN 5 , 15Q)
(JUMPA SAVECRRESTART)
(CAIN 5 , 37Q)
(JUMPA SAVERESTART)
FIRSTCHKENDFORWCR
(CAMN 1 , 2)
(JSP 6 , NEXTREC)
(JUMPA FIRSTFORWARDCR)
SAVECRRESTART
(* jump to SAVERESTART just long enough to set up the restart info, then return to here and be sure next char is LF.
If so, start find rest search, else, restart. We must be sure to tell SAVERESTART to send us back here.
Therefore, leave 1 in AC4. It will usually have 0 in it.)
(MOVEI 4 , 1)
(JUMPA SAVERESTART)
SAVECRRESTART-RETURN
(CAMN 1 , 2)
(JSP 6 , NEXTREC)
(ILDB 5 , 1)
(CAIN 5 , 12Q)
(JUMPA FINDRESTSETUP)
(JUMPA RESTART)
FIRSTBACK
(ADD 1 , = 70000000000Q)
(CAIGE 1 , 0)
(SUB 1 , = -347777777777Q)
(CAMN 1 , 2)
(JSP 6 , PREVREC)
FETCHBACK
(LDB 5 , 1)
(CAMN 3 , 5)
(JUMPA SAVERESTART)
(JUMPA FIRSTBACK)
FIRSTBACKCR
(ADD 1 , = 70000000000Q)
(CAIGE 1 , 0)
(SUB 1 , = -347777777777Q)
(CAMN 1 , 2)
(JSP 6 , PREVREC)
FETCHBACKCR
(LDB 5 , 1)
(CAIN 5 , 12Q)
(JUMPA FIRSTCHKLFCR)
(CAIN 5 , 37Q)
(JUMPA SAVERESTART)
(JUMPA FIRSTBACKCR)
FIRSTCHKLFCR
(ADD 1 , = 70000000000Q)
(CAIGE 1 , 0)
(SUB 1 , = -347777777777Q)
(CAMN 1 , 2)
(JSP 6 , PREVREC)
(LDB 5 , 1)
(CAIE 5 , 15Q)
(JUMPA FETCHBACKCR 1)
(JUMPA SAVECRRESTART)
(* We now know we have found a CR/LF. Must save current position -- on the CR -- and then move forward to LF before
resuming search for rest. Use the code at SAVECRRESTART to do this, even though it assumes we don't KNOW the next
char is a LF.)
SAVERESTART
(* we get here when we have found the first char. We want to save enough stuff to continue the first char search if
this isn't the right occurrence of the first char. There is a special situation in which we want to set up the
restart info and then do a few things more before starting the search for the rest. If this is the case, AC4 will
have 1 in it. When it has 1 in it, we are to jump to SAVECRRESTART-RETURN rather than falling thru to the find rest
setup stuff.)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
(MOVE 6 , KNIL)
(VAR (HRRM 6 , FINDFIRSTMODE))
(VAR (HRRZ 6 , EDITSEARCHREC2))
(VAR (HRRM 6 , EDITSEARCHREC1))
(VAR (HRRZ 6 , EDITSEARCHPOS2))
(VAR (HRRM 6 , EDITSEARCHPOS1))
(NREFE (MOVE 6 , CURINITBP))
(NREFE (MOVEM 6 , SAVECURINITBP))
(NREFE (MOVE 2 , CURENDBP))
(NREFE (MOVEM 2 , SAVECURENDBP))
(CAIE 4 , 0)
(JUMPA SAVECRRESTART-RETURN)
(* now all restart info has been saved. Now continue by either returning to where saverestart was called from, or
proceeding with the find rest stuff, according to whether AC4 is non-0)
FINDRESTSETUP
(NREFE (MOVE 3 , STRINITBP))
(NREFE (MOVE 4 , STRENDBP))
(JUMPA CHKEND)
FINDREST
(ILDB 5 , 1)
(ILDB 6 , 3)
(CAMN 5 , 6)
(JUMPA CHKEND)
(CAIE 6 , 37Q)
(JUMPA RESTART)
(CAIE 5 , 15Q)
(JUMPA RESTART)
(CAMN 1 , 2)
(JSP 6 , NEXTREC)
(ILDB 5 , 1)
(CAIE 5 , 12Q)
(JUMPA RESTART)
CHKEND
(CAMN 3 , 4)
(JUMPA WIN)
(CAMN 1 , 2)
(JSP 6 , NEXTREC)
(JUMPA FINDREST)
RESTART
(CQ (SETQ EDITSEARCHREC2 EDITSEARCHREC1)
(SETQ EDITSEARCHPOS2 EDITSEARCHPOS1))
(NREFE (MOVE 6 , SAVECURINITBP))
(NREFE (MOVEM 6 , CURINITBP))
(NREFE (MOVE 6 , SAVECURENDBP))
(NREFE (MOVEM 6 , CURENDBP))
(NREFE (MOVE 1 , SAVE-AC1))
(NREFE (MOVE 2 , SAVE-AC2))
(NREFE (MOVE 3 , FIRSTCHAR))
(MOVEI 4 , 0)
(* load AC1-AC4 with stuff for first char loop. AC4 is set to 0 which means when we get to SAVERESTART we will fall
through and start the find rest setup. If this isn't what we should do SAVECRRESTART will reset AC4 to 1 just before
the jump to SAVERESTART. So this setting of AC4 is like a predictable background that we either let be or change.
Next, dispatch back to the appropriate first char loop.)
(MOVE 6 , KT)
(VAR (HRRM 6 , FINDFIRSTMODE))
(NREFE (MOVE 6 , DISPATCHER))
(ADDI 6 , *)
(JUMPA @ 6)
(JUMPA FIRSTCHKENDFORW)
(JUMPA FIRSTCHKENDFORWCR)
(JUMPA FIRSTBACK)
(JUMPA FIRSTBACKCR)
NEXTREC
(SUBI 6 , TOP)
(NREFE (MOVEM 3 , SAVE-AC3))
(NREFE (MOVEM 4 , SAVE-AC4))
(NREFE (MOVEM 6 , RETURN-LINK))
NEXTREC+2
[CQ (AND FINDFIRSTMODE (UNLOCK EDITSEARCHREC2))
(COND
([OR (EQ EDITSEARCHREC2 REC2)
(BTMRECP (SETQ EDITSEARCHREC2
(fetch TXDTNEXT of EDITSEARCHREC2]
(JRST LOSE)))
(SETQ EDITSEARCHPOS2 (OR (AND (EQ EDITSEARCHREC2 REC1)
POS1)
(fetch TXDTOFFSET1 of
EDITSEARCHREC2]
LOADRECFORW
(CQ (LOADREC EDITSEARCHREC2 EDITSEARCHPOS2
(AND (EQ EDITSEARCHREC2 REC2)
POS2)
FINDFIRSTMODE)
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(JRST NEXTREC+2)))
(VAG (BYTEPOINTER BASEADDR OFFSET2)))
(PUSHN 1)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(POPN 2)
(NREFE (MOVEM 1 , CURINITBP))
(NREFE (MOVEM 2 , CURENDBP))
(NREFE (MOVE 4 , SAVE-AC4))
(NREFE (MOVE 3 , SAVE-AC3))
(NREFE (MOVE 6 , RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6)
PREVREC
(SUBI 6 , TOP)
(NREFE (MOVEM 3 , SAVE-AC3))
(NREFE (MOVEM 4 , SAVE-AC4))
(NREFE (MOVEM 6 , RETURN-LINK))
PREVREC+2
[CQ (AND FINDFIRSTMODE (UNLOCK EDITSEARCHREC2))
(COND
([OR (EQ EDITSEARCHREC2 REC1)
(TOPRECP (SETQ EDITSEARCHREC2
(fetch TXDTPREV of EDITSEARCHREC2]
(JRST LOSE)))
(SETQ EDITSEARCHPOS2 (OR (AND (EQ EDITSEARCHREC2 REC1)
POS1)
(fetch TXDTOFFSET1 of
EDITSEARCHREC2]
LOADRECBACK
(CQ (COND
((BTMRECP EDITSEARCHREC2)
(JRST PREVREC+2)))
(LOADREC EDITSEARCHREC2 EDITSEARCHPOS2
(AND (EQ EDITSEARCHREC2 REC2)
POS2)
FINDFIRSTMODE)
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(JRST PREVREC+2)))
(VAG (BYTEPOINTER BASEADDR OFFSET1)))
(PUSHN 1)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET2)))
(POPN 2)
(NREFE (MOVEM 2 , CURINITBP))
(NREFE (MOVEM 1 , CURENDBP))
(NREFE (MOVE 4 , SAVE-AC4))
(NREFE (MOVE 3 , SAVE-AC3))
(NREFE (MOVE 6 , RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6)
LOSE(CQ (PROGN (COND
((AND BACK (NOT FINDFIRSTMODE))
|
(* if|we ran off the end while in FINDREST mode during a backwards search, then we ran off the right-hand end, which
doesn't mean|we have completely lost. In this case we just want to restart after we clear off and CP.)
|
|
(JRST RESTART))) |
| (* this rec might be locked in if we were in FINDREST
mode)
(UNLOCK EDITSEARCHREC1)))
(NREFE (MOVE 1 , FINDCOUNT))
(CQ (LOC (AC)))
(SETQ TXDTFINDCNT)
(CQ (SETQ TXDTFINDCNT (IDIFFERENCE COUNT TXDTFINDCNT))
NIL)
(JUMPA EXIT)
CALCOFFSET
(CALCOFFSET)
(POPJ CP ,)
WIN (NREFE (SOSLE FINDCOUNT))
(JUMPA RESTART)
(MOVE 2 , 1)
(NREFE (MOVE 1 , CURINITBP))
(PUSHJ CP , CALCOFFSET)
(CQ (IPLUS (LOC (AC))
EDITSEARCHPOS2 1))
(SETQ EDITSEARCHPOS2)
(NREFE (MOVE 1 , SAVECURINITBP))
(NREFE (MOVE 2 , SAVE-AC1))
(PUSHJ CP , CALCOFFSET)
(CQ (IPLUS (LOC (AC))
EDITSEARCHPOS1))
(SETQ EDITSEARCHPOS1)
(CQ (SETQ TXDTFINDCNT COUNT)
(UNLOCK EDITSEARCHREC1)
T)
EXIT(POPNN 16Q]
[COND
([AND BACK (NOT (ILESSP EDITSEARCHPOS2 (fetch TXDTOFFSET2 of EDITSEARCHREC2]
(SETQ EDITSEARCHREC2 (fetch TXDTNEXT of EDITSEARCHREC2))
(SETQ EDITSEARCHPOS2 (fetch TXDTOFFSET1 of EDITSEARCHREC2]
(TXDTBREAKLOCKS)
(SETQ TXDTRESETFORMBREAKLOCKSFLG NIL)
BACK])
(EDITSUBST
[LAMBDA (NEWSTR OLDSTR REC1 POS1 REC2 POS2 BACKWARDS MAXSUBSTS
COUNTLCFLG)
(* substitutes NEWSTR for OLDSTR in the given window.
Goes backwards if BACKWARDS is set. If MAXSUBSTS is NIL it makes as many
substituttions as possible. If MAXSUBSTS is non-NIL it is assumed to be the
maximum number of substitutions to be made. When done,
EDITINSERTREC2,EDITINSERTPOS2 or EDITINSERTREC1,EDITINSERTPOS1 is the
location of the last substitution is the loc of the end or the beginning of
the final insertion of NEWSTR, depending on BACKWARDS The function returns
the total number of substitutions actually performed.
If COUNTLCFLG is CHARS, TXDTDELTA is set to the total change in the number
of characters. If it is LINES, its set to the total change in the number of
lines. If BOTH, it sets it to the dotted pair with the line difference in
the CAR and an unspecified obj in the CDR.)
(PROG (TEMP SAVEDTXDTDELTA (INITCOUNT MAXSUBSTS))
(SETQ TEMP (COND
((EQ COUNTLCFLG (QUOTE BOTH))
(QUOTE LINES))
(T COUNTLCFLG)))
(COND
((NOT MAXSUBSTS)
(SETQ MAXSUBSTS -1)))
(COND
(BACKWARDS (* if we are to do it backwards, use the
backwards loop.)
(GO BACKWARDS)))
(SETQ EDITINSERTREC2 REC1)
(SETQ EDITINSERTPOS2 POS1)
(* we will loop looking for OLDSTR and when found, delete it and insert
NEWSTR. We then want to resume looking for OLDSTR immed following the
insertion. Therefore, use the globals maintained by EDITINSERT to hold the
current starting place.)
(COND
((ZEROP (NCHARS OLDSTR)) (* if OLDSTR is empty, quit now)
(AND COUNTLCFLG (SETQ TXDTDELTA
(OR (AND (EQ COUNTLCFLG (QUOTE BOTH))
(CONS 0 0))
0)))
(RETURN 0)))
FORWLOOP
(COND
((AND (NEQ MAXSUBSTS 0)
(EDITSEARCH OLDSTR EDITINSERTREC2 EDITINSERTPOS2 REC2
POS2)) (* find next occurrence of OLDSTR)
(EDITDELETE EDITSEARCHREC1 EDITSEARCHPOS1 EDITSEARCHREC2
EDITSEARCHPOS2 TEMP)
(AND TEMP (SETQ SAVEDTXDTDELTA TXDTDELTA))
(EDITINSERT NEWSTR EDITDELETEREC EDITDELETEPOS TEMP)
(AND TEMP (SETQ TEMP NIL))
(* insert the new string in its place)
(SETQ MAXSUBSTS (SUB1 MAXSUBSTS))
(* decrmt subst counter)
(GO FORWLOOP) (* and keep looping)
))
(GO EXIT)
BACKWARDS
(* This is very much like the forward loop except that it is REC2,POS2 we
must push toward REC1,POS1 rather than vice versa. One additional note: we
must resume searching for the next occurrence in front of rather than
behind the current insertion, to prevent possible subst into NEWSTR
itself.)
(SETQ EDITINSERTREC1 REC2)
(SETQ EDITINSERTPOS1 POS2)
(COND
((ZEROP (NCHARS OLDSTR))
(AND COUNTLCFLG (SETQ TXDTDELTA
(OR (AND (EQ COUNTLCFLG (QUOTE BOTH))
(CONS 0 0))
0)))
(RETURN 0)))
BACKLOOP
(COND
((AND (NEQ MAXSUBSTS 0)
(EDITSEARCH OLDSTR REC1 POS1 EDITINSERTREC1
EDITINSERTPOS1 T))
(EDITDELETE EDITSEARCHREC1 EDITSEARCHPOS1 EDITSEARCHREC2
EDITSEARCHPOS2 TEMP)
(AND TEMP (SETQ SAVEDTXDTDELTA TXDTDELTA))
(EDITINSERT NEWSTR EDITDELETEREC EDITDELETEPOS TEMP)
(AND TEMP (SETQ TEMP NIL))
(SETQ MAXSUBSTS (SUB1 MAXSUBSTS))
(GO BACKLOOP)))
EXIT
(* first compute how many substs we made, and then compute the total change
in the lines/chars if needed.)
[SETQ TEMP (COND
((ILESSP MAXSUBSTS 0)
(* if count is neg, it was NIL to begin with and we made -COUNT+1
substitutions)
(IMINUS (ADD1 MAXSUBSTS)))
(T (* otherwise, we made:)
(IDIFFERENCE INITCOUNT MAXSUBSTS]
[COND
(COUNTLCFLG (SETQ TXDTDELTA (ITIMES TEMP (IPLUS TXDTDELTA
SAVEDTXDTDELTA)))
(COND
((EQ COUNTLCFLG (QUOTE BOTH))
(SETQ TXDTDELTA (CONS TXDTDELTA
(QUOTE
UNABLE-TO-GIVE-MEANINGFUL-CHAR-COUNT]
(RETURN TEMP])
(EDITUNSPLITCRLF
[LAMBDA (REC POS BACKWARDS)
(* If REC,POS addresses a LF preceded by a CR, then this function returns T
and sets EDITCHARREC,EDITCHARPOS to either the CR or to the location
folloing the LF, dependin on BACKWARDS.)
(PROG NIL
(SETQ EDITCHARREC REC)
(SETQ EDITCHARPOS POS)
(COND
((BTMRECP REC)
(RETURN NIL)))
(LOADREC REC POS POS)
(COND
((NEQ 10 (EDITCHAR1)) (* If char at REC,POS isnt a LF, return
NIL.)
(RETURN NIL)))
(EDITCHAR3 T) (* REC,POS addresses a LF so back up one
char.)
(COND
((NEQ 13 (EDITCHAR1)) (* If that LF isnt preceded by CR,
return NIL)
(RETURN NIL)))
(COND
((NOT BACKWARDS)
(EDITCHAR2)
(EDITCHAR2 T)))
(* It was preceded by a CR. If BACKWARDS, we are correctly set up.
If forward, forward twice, to past LF, and see that answer rec is loaded in
-- just because it seems it will often be used.)
(RETURN T])
(EDITWRITE
(LAMBDA (FILENAME REC1 POS1 REC2 POS2)
(* Writes the chars in the given
window to FILE and closes it)
(SETQ TXDTRESETFORMBREAKLOCKSFLG T)
(TXDTBREAKLOCKS)
(SETQ FILENAME
(COND
((XNLSETQ
(PROG (FILEJFN PGNO TXDTPAGEX MSG LASTMSG)
(SETQ FILENAME (OPENF (SETQ FILEJFN
(GTJFN FILENAME TXDTEXTENSION
-1 -34359738368))
7516291072))
(* Open file, with ext
defaulting to TXDTEXTENSION.
Flags specify Read and Write.)
(SETQ EDITREADFILELST (CONS FILENAME EDITREADFILELST))
(* add it to list of files
possibly PMAPed in)
(SETQ PGNO -1)
(* PGNO is the page no we are currently writing onto.
Prepare it to absorb first incrmt.)
(SETQ REC1 (fetch TXDTPREV of REC1))
(* In order to load the first REC, we just go to the record
stepper MOVEREC, which advances one rec and then loads it.
Prepare for the first, unwanted, step by stepping back one.
Tactical retreat.)
(ASSEMBLE NIL
TOP (DCLCONSTS ((MOVEREC-RETURN-LINK -6)
(SAVE-AC1 -5)
(SAVE-AC2 -4)
(NEXTPAGE-RETURN-LINK -3)
(SAVE-AC3 -2)
(SAVE-AC4 -1)
(SAVE-AC5 0)))
(* In two places -
MOVEREC and NEXTPAGE -
we need to save acs. Because of msg printing we may have to
save all acs at once -- we might be MOVEREC printing the %
msg and run off the page and have to go to NEXTPAGE.)
(PUSHNN (1)
(1)
(1)
(1)
(1)
(1)
(1))
(JSP 6 , NEXTPAGE)
(JSP 6 , MOVEREC)
(* these two PUSHJs configure the ACs as follows: AC1 =
current bp for char sink. AC2 = end bp for char sink.
AC3 = current bp for char source. AC4 = end bp for char
source.)
(JUMPA CHKEND)
(* jump into loop and be sure
space is non-empty)
LOOP(ILDB 5 , 3)
(* fetch a byte)
(CAIN 5 , 37Q)
(* compare char to EOL)
(JSP 6 , WRITECRLF)
(* if its an EOL, call it CR/LF)
(IDPB 5 , 1)
(* write char in AC5 to output
page)
CHKEND
(CAMN 1 , 2)
(* see if at end of sink)
(JSP 6 , NEXTPAGE)
(* if so, get next page and
continue)
(CAMN 3 , 4)
(* see if at end of source)
(JSP 6 , MOVEREC)
(* if so, go get next record)
(JUMPA LOOP)
(* keep looping -- eventually we
won't return from MOVEREC)
WRITECRLF
(* write a CR/LF and check for end of sink.
We get here via a JSP on 6 and we will leave 6 untouched so we
can return thru it without bothering to save 6)
(MOVEI 5 , 15Q)
(IDPB 5 , 1)
(MOVEI 5 , 12Q)
(CAMN 1 , 2)
(JUMPA NEXTPAGE)
(* go get next page. NOTE: AC6 still has our return link in
it. Rather than JSP on 6 to NEXTPAGE we will just JUMPA there,
knowing that AC6 is our return link and that the JUMPA @ at
the end of NEXTPAGE will send us back to the main loop.
When we get back in the loop we'll be at the IDPB and will
write the LF now in AC5.)
(JUMPA @ 6)
(* Continue looping)
NEXTPAGE (* get next page of output file)
(SUBI 6 , TOP)
(NREFE (MOVEM 3 , SAVE-AC3))
(NREFE (MOVEM 4 , SAVE-AC4))
(NREFE (MOVEM 5 , SAVE-AC5))
(NREFE (MOVEM 6 , NEXTPAGE-RETURN-LINK))
(* These ACs must be protected because they are in use at the
time this routine is used.)
(CQ (PROGN (SETQ PGNO (ADD1 PGNO))
(* incrmt PGNO for file)
(COND
(TXDTPAGEX (SWAPOUT TXDTPAGEX))
)
(* if we'e ever swapped anything into TXDTPAGEX swap it out
now. This will also unlock it. Usually we'll swap the next
page of the output file into that slot with the next
instruction.)
(SETQ TXDTPAGEX
(SWAPIN (PACKJFNPG FILEJFN
PGNO)
T))
(* load AC1 final init bp)
(VAG (BYTEPOINTER TXDTPAGEX
5000Q))))
(PUSHN 1) (* save it while we calc the
init bp)
(CQ (VAG (BYTEPOINTER TXDTPAGEX 0)))
(POPN 2) (* put init bp into AC1 and
final bp into AC2)
(NREFE (MOVE 5 , SAVE-AC5))
(* now restore registers.)
(NREFE (MOVE 4 , SAVE-AC4))
(NREFE (MOVE 3 , SAVE-AC3))
(NREFE (MOVE 6 , NEXTPAGE-RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6)
(* now continue)
MOVEREC
(SUBI 6 , TOP)
(* step to next rec)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
(NREFE (MOVEM 6 , MOVEREC-RETURN-LINK))
(* Save the ACs not having to do
with the current segment)
MOVEREC+2
(CQ (COND
((OR (EQ REC1 REC2)
(BTMRECP (SETQ REC1
(fetch TXDTNEXT
of REC1))))
(* if we've done the last rec,
quit)
(JRST WRITESIZE))
(T
(* not done yet. test above advanced to new rec.
before setting it up, print its msg if necessary.)
(COND
((AND TXDTESCAPECHAR
(SETQ MSG
(fetch TXDTMSG
of REC1))
(NEQ MSG LASTMSG))
(SETQ LASTMSG MSG)
(JRST WRITEMSG))
(T (JRST SKIPMSG))))))
WRITEMSG
(CQ (VAG (CHCON1 TXDTESCAPECHAR)))
(MOVE 5 , 1)
(NREFE (MOVE 1 , SAVE-AC1))
(NREFE (MOVE 2 , SAVE-AC2))
(IDPB 5 , 1)
(CAMN 1 , 2)
(JSP 6 , NEXTPAGE)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
(CQ (VAG (CHCON1 MSG)))
(MOVE 5 , 1)
(NREFE (MOVE 1 , SAVE-AC1))
(NREFE (MOVE 2 , SAVE-AC2))
(IDPB 5 , 1)
(CAMN 1 , 2)
(JSP 6 , NEXTPAGE)
(NREFE (MOVEM 1 , SAVE-AC1))
(NREFE (MOVEM 2 , SAVE-AC2))
SKIPMSG
(CQ (LOADREC REC1
(OR POS1
(fetch TXDTOFFSET1
of REC1))
(COND
((EQ REC1 REC2)
POS2)
(T NIL)))
(SETQ POS1 NIL)
(COND
((NOT (ILESSP OFFSET1 OFFSET2))
(JRST MOVEREC+2)))
(VAG (BYTEPOINTER BASEADDR OFFSET1)))
(PUSHN 1)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET2)))
(* calc end bp for source)
(MOVE 4 , 1)
(* AC4 = end bp for source)
(POPN 3) (* AC3 = start bp for source)
(NREFE (MOVE 2 , SAVE-AC2))
(* and restore AC2 and AC1)
(NREFE (MOVE 1 , SAVE-AC1))
(NREFE (MOVE 6 , MOVEREC-RETURN-LINK))
(ADDI 6 , TOP)
(JUMPA @ 6)
(* continue)
WRITESIZE
(* All done writing. We must now calculate the total number of
bytes written so that we can store that in the File Descriptor
Block of the file.)
(NREFE (MOVE 2 , SAVE-AC2))
(NREFE (MOVE 1 , SAVE-AC1))
(* restore AC1 and AC2 to
current and end bp for sink)
(CALCOFFSET)
(* calc no of chars sep them,
less 1)
(ADDI 1 , 1)
(* Add that 1 back in)
(PUSHN 1)
(* AC1 = no of unwritten bytes at end of last page.
Save it.)
(CQ (VAG FILEJFN))
(PUSHN 1) (* push FILEJFN jfn for future
use)
(CQ (VAG (ITIMES (ADD1 PGNO)
5000Q)))
(* now calc the total number of bytes in file if last page
were full.)
(MOVE 3 , 1)
(* put it in AC3 in prep for a
JSYS)
(POPN 1) (* AC1 = FILEJFN jfn)
(POPN 2) (* put unwritten byte count into
AC2)
(SUB 3 , 2)
(* and sub it from full page byte count.
Now AC3 has the total number of bytes written to the file.)
(HRLI 1 , 12Q)
(* put displacement for FDBSIZ
into AC1-left)
(MOVE 2 , = -1)
(* All Ones = bit mask for whole
word in AC2)
(JSYS 64Q)
(* CHFDB -
set file size in File
Descriptior Block)
(HRLI 1 , 11Q)
(* Now set byte size to 7)
(MOVE 2 , = 7700000000Q)
(* mask for B6-B11)
(MOVE 3 , = 700000000Q)
(* byte size 7)
(JSYS 64Q)
(* CHFDB to set byte size)
(POPNN 7) (* clear off the number slots)
)
(RETURN))
NOBREAK)
(* if no errors occured, then close the file and return the
full filename. Since EDITCLOSEF must do a SWAPOUT of any pages
currently mapped in, this will unlock any locked pages
associated with the output file.)
(EDITCLOSEF FILENAME))
((OPENP FILENAME)
(* if an error occured and the output file is open, we want to
close it and unlock any locked pages)
(EDITCLOSEF FILENAME)
(DELFILE FILENAME)
(ERROR "TXDTWRITE INTERRUPTED - FILE CLOSED AND DELETED"
FILENAME))
(T (* error occured, but file not
open. Just break any locks)
(ERROR!))))
(TXDTBREAKLOCKS)
(SETQ TXDTRESETFORMBREAKLOCKSFLG NIL)
FILENAME))
(GETBTMREC
[LAMBDA (REC) (* decends to btm of chain from rec)
(PROG (NEXT)
LOOP(SETQ NEXT (FETCH TXDTNEXT OF REC))
(COND
((EQ NEXT REC)
(RETURN REC)))
(SETQ REC NEXT)
(GO LOOP])
(GETTOPREC
[LAMBDA (REC) (* climbs to the top of the chain from
REC)
(PROG (PREV)
LOOP(SETQ PREV (FETCH TXDTPREV OF REC))
(COND
((EQ PREV REC)
(RETURN REC)))
(SETQ REC PREV)
(GO LOOP])
(LOADREC
[LAMBDA (REC POS1 POS2 LOCK)
(* This function sets up BASEADDR, OFFSET1 and OFFSET2 for REC.
It swaps the necessary page into ADDR if its not already in, and sets
OFFSET1 and OFFSET2 to be the correct values for constructing byte
pointers.)
(SETN LOADRECSOURCEBOX (fetch TXDTSOURCE of REC))
(COND
((ILESSP LOADRECSOURCEBOX 0)
(ERROR "TXDT ERROR - ATTEMPT TO LOADREC TOP/BTM" REC)))
(SETQ BASEADDR (SWAPIN LOADRECSOURCEBOX LOCK))
[COND
(POS1 (SETN OFFSET1 (IPLUS 1500 POS1)))
(T (SETN OFFSET1 (IPLUS 1500 (fetch TXDTOFFSET1 of REC]
(COND
(POS2 (SETN OFFSET2 (IPLUS 1500 POS2)))
(T (SETN OFFSET2 (IPLUS 1500 (fetch TXDTOFFSET2 of REC])
(MARKEDP
[LAMBDA (CHAIN)
(* Returns T iff all recs in chain are marked by having TXDTOFFSET2 less
than -1500)
(PROG (X)
LOOP(COND
((NOT (type? TXDTRECORD CHAIN))
(RETURN T)))
(SETQ X (fetch TXDTOFFSET2 of CHAIN))
(COND
((NOT (ILESSP X -1500))
(RETURN NIL)))
(SETQ CHAIN (fetch TXDTNEXT of CHAIN))
(GO LOOP])
(PMAP
[LAMBDA (JFNPGNO PAGEADDR)
(PROG NIL
TOP (SETN TXDTPMAPCNT (ADD1 TXDTPMAPCNT))
[COND
((AND (NEQ JFNPGNO -1)
(ASSEMBLE NIL
(CQ (VAG (LRSH JFNPGNO 22Q)))
(JSYS 24Q)
(MOVE 1 , KT)
(TLNE 2 , 200Q)
(MOVE 1 , KNIL)))
(* THIS CODE IS HERE TO TRY TO FIND OUT HOW WE ARE GETTING TRAPS IN PMAP)
(PROG (OLDJFN NEWJFN)
GETNEWJFN
[SETQ NEWJFN (TXDTGETNEWJFN (SETQ OLDJFN
(LRSH JFNPGNO 18]
(COND
((OR (NOT (SMALLP NEWJFN))
(ILESSP NEWJFN 0))
(GO GETNEWJFN)))
(TXDTSUBSTJFNS (LIST (CONS OLDJFN NEWJFN))
NIL)
(SETQ JFNPGNO (LOGOR (LLSH NEWJFN 18)
(LOGAND JFNPGNO 262143)))
(GO TOP]
(ASSEMBLE NIL
(* PMAPs PGNO of file with jfn JFN into PAGEADDR. It is assumed that
JFNPGNO is already properly packed. The access flags are set to Read,
Write, and Execute but are anded with the access bits of the file page.)
(CQ (VAG (LOGOR (LRSH (LOC PAGEADDR)
11Q)
-400000000000Q)))
(PUSHN 1)
(CQ (VAG JFNPGNO))
(POPN 2)
(MOVE 3 , = 160000000000Q)
(JSYS 56Q) (* PMAP)
)
(RETURN JFNPGNO])
(PRINTSEG
[LAMBDA (REC POS1 POS2 DESTJFN BITMASK)
(* prints text in window to destjfn,
convertiong EOL to CR/LF.)
(COND
[(ILESSP POS1 POS2) (* don't do anything unless POS1 is
before POS2!)
(LOADREC REC POS1 POS2)
(LOC (ASSEMBLE NIL
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET1)))
(PUSHN 1) (* save init bp)
(CQ (VAG (BYTEPOINTER BASEADDR OFFSET2)))
(PUSHN 1) (* save end bp)
(CQ (VAG BITMASK))
(PUSHN 1)
(CQ (VAG DESTJFN))
(* set AC1 to destination jfn)
(POPN 6) (* set AC6 to the bitmask controlling
the printing of control chars)
(POPN 4) (* put end bp in AC4)
(POPN 3) (* put current bp into AC3)
LOOP(ILDB 2 , 3) (* load byte into AC2)
(MOVE 5 , 6) (* put mask in 5 to shift it)
(LSH 5 , @ 2) (* leftshift it by the byte)
(TLNE 5 , 400000Q)
(* skip if bit 0 is off)
(JUMPA CHKEND)
(* If there was a 1 in the bit position indicated by the byte, skip all
printing. This means a mask of 0 will be a noop and that all chars > 43Q
will be printed always.)
(CAIN 2 , 37Q) (* see if char is EOL)
(JUMPA CONVEOL)
(* if so, convert it to CR/LF)
BOUT(JSYS 51Q) (* output it)
CHKEND
(CAME 3 , 4) (* compare end bp with current)
(JUMPA LOOP) (* if not yet at end, loop)
(JUMPA EXIT) (* otherwise, exit)
CONVEOL (* write CR/LF for EOL just fetched)
(MOVEI 2 , 15Q)
(JSYS 51Q)
(MOVEI 2 , 12Q)
(JUMPA BOUT)
EXIT(MOVE 1 , 2]
(T 0])
(REOPENFILE
[LAMBDA (FILENAME OLDJFN MODE FILEPTR)
(* Opens FILENAME for access MODE and sets the fileptr to FILEPTR.
Returns a pair (oldjfn . newjfn))
(PROG (TEMPREC)
(SELECTQ MODE
(IOFILE (IOFILE FILENAME))
(INPUT (INPUT (INFILE FILENAME)))
(OUTPUT (OUTPUT (OUTFILE FILENAME)))
(ERROR "UNRECOGNIZED MODE" MODE))
(SETFILEPTR FILENAME FILEPTR)
(RETURN (CONS OLDJFN (OPNJFN FILENAME])
(RTXDT
[LAMBDA NIL
(PROG NIL |
[SETQ RTXDTFNS (for FN in TXDTFNS collect FN unless (AND (MEMB FN HIDDENFNS)
(NEQ FN (QUOTE TXDTPRINTUSERFN]
(SETQ RTXDTCOMS
(for COM|in TXDTCOMS
collect
(SELECTQ (CAR COM)
(FNS (QUOTE (FNS * RTXDTFNS)))
(VARS (REMOVE|(QUOTE HIDDENFNS)
COM)) |
[BLOCKS |
(LIST (QUOTE BLOCKS)
(CONS (QUOTE|TXDT)
(APPEND RTXDTFNS
(for X in (CADR (ASSOC (QUOTE BLOCKS)
TXDTCOMS))
when (LISTP X)
collect (SELECTQ (CAR X)
[ENTRIES
(CONS (QUOTE ENTRIES)
(for FN
in (CDR X)
collect FN
unless (MEMB FN
HIDDENFNS]
[NOLINKFNS
(CONS (QUOTE NOLINKFNS)
(for FN
in (CDR X)
collect FN
unless (MEMB FN
HIDDENFNS]
X] |
COM))) |
(RETURN NIL])
(SMASHJFN
[LAMBDA (ALIST REC)
(* ALIST is assumed to be an alist of (OLDJFN . NEWJFN) Unless REC has been put into the SMASHEDRECHASHARRAY replace
all references to OLDJFN with NEWJFN -- incuding in the records in the split rec list.)
(PROG (PAIR) |
(COND
((NOT (GETHASH REC SMASHEDRECHASHARRAY))
(SETN TXDTTEMPSOURCEBOX (fetch TXDTSOURCE of REC))
(COND
((AND (NUMBERP TXDTTEMPSOURCEBOX)
(SETQ PAIR (ASSOC (LRSH TXDTTEMPSOURCEBOX 18)
ALIST)))
(replace TXDTSOURCE of REC with (LOGOR (LLSH (CDR PAIR)
18)
(LOGAND TXDTTEMPSOURCEBOX 262143)))
(PUTHASH REC T SMASHEDRECHASHARRAY)))
(* I think we could get away with only doing this recursion on recs we had to smash -- supposedly, all the sources
of the splitrecs are eq to that of the original rec. But just in case that isn't so, or doesn't stay so, I'll do it
this way.)
(for X in (fetch TXDTSPLITRECS of REC) do (SMASHJFN ALIST X])
(SWAPIN
[LAMBDA (JFNPGNO LOCK)
(* swaps JFNPGNO -- a packed jfn and page no -- into any available page if
its not already in. If LOCK is on, the page containing JFNPGNO is LOCKed
in, so that it cannot be swapped into. The page address of the chosen page
is returned.)
(SETN TXDTSWAPCNT (ADD1 TXDTSWAPCNT))
(COND
((IEQP JFNPGNO TXDTPAGE1CONTENTS)
(SETN TXDTPAGE1CNT TXDTSWAPCNT)
[COND
(LOCK (SETN TXDTPAGE1LOCK (ADD1 TXDTPAGE1LOCK]
TXDTPAGE1)
((IEQP JFNPGNO TXDTPAGE2CONTENTS)
(SETN TXDTPAGE2CNT TXDTSWAPCNT)
[COND
(LOCK (SETN TXDTPAGE2LOCK (ADD1 TXDTPAGE2LOCK]
TXDTPAGE2)
([AND (IEQP TXDTPAGE1LOCK 0)
(OR (ILESSP TXDTPAGE1CNT TXDTPAGE2CNT)
(NOT (IEQP TXDTPAGE2LOCK 0]
(SETN TXDTPAGE1CONTENTS (PMAP JFNPGNO TXDTPAGE1))
(SETN TXDTPAGE1CNT TXDTSWAPCNT)
(COND
(LOCK (SETN TXDTPAGE1LOCK 1)))
TXDTPAGE1)
((IEQP TXDTPAGE2LOCK 0)
(SETN TXDTPAGE2CONTENTS (PMAP JFNPGNO TXDTPAGE2))
(SETN TXDTPAGE2CNT TXDTSWAPCNT)
(COND
(LOCK (SETN TXDTPAGE2LOCK 1)))
TXDTPAGE2)
(T (TXDTBREAKLOCKS)
(ERROR
"TXDT PAGING ERROR -- PROBABLY DUE TO TXDTMAPCHARS
Both of TXDT's page buffers are tied down and a third one is
now being requested. Unless there is a bug in J's code this
never happens in TXDT unless you are using TXDT functions inside
of the mapping function in TXDTMAPCHAR. If you find that this is
not the case, report this bug to J."])
(SWAPOUT
[LAMBDA (ADDR)
(* un-PMAPs the page in ADDR and resets its lock to 0.0 Note: This function
doesn't care whether the page is locked in or not!)
(COND
((EQ ADDR TXDTPAGE1)
(PMAP -1 TXDTPAGE1)
(SETN TXDTPAGE1CONTENTS -1)
(SETN TXDTPAGE1CNT 0)
(SETN TXDTPAGE1LOCK 0))
(T (PMAP -1 TXDTPAGE2)
(SETN TXDTPAGE2CONTENTS -1)
(SETN TXDTPAGE2CNT 0)
(SETN TXDTPAGE2LOCK 0])
(TOPRECP
[LAMBDA (REC)
(EQ REC (FETCH TXDTPREV OF REC])
(TXDTADDRP
[LAMBDA (X)
(AND (TYPE? TXDTADDR X)
X])
(TXDTANCHOREDFIND
[LAMBDA (STR ADDR1 ADDR2 BACKWARDS BEHIND OLDBOX)
(* Like TXDTFIND except that it does not allow the search to move from the
beginning or end address -- depending on the direction of search.
That is, for a forward search, it must find STR starting at ADDR1 and
contained in the window closed by ADDR2. Analogously for backward
searches.)
(PROG (TEMPADDR)
(OR (STRINGP STR)
(SETQ STR (MKSTRING STR)))
(OR (TXDTADDRP ADDR1)
(SETQ ADDR1 (TXDTCOPY ADDR1)))
(OR (TXDTADDRP ADDR2)
(SETQ ADDR2 (TXDTCOPY ADDR2)))
(RETURN (COND
(BACKWARDS
(TXDTCHAR (SETQ TEMPADDR (TXDTBOX ADDR2 OLDBOX))
T -1)
(COND
((for I from (NCHARS STR) to 1 by -1
always (COND
[(TXDTEQUAL ADDR1 TEMPADDR)
(AND (EQ I 1)
(EQ (NTHCHAR STR 1)
(TXDTCHAR TEMPADDR NIL
NIL]
([EQ (NTHCHAR STR I)
(TXDTCHAR TEMPADDR NIL
(COND
((EQ I 1)
NIL)
(T -1]
T)
(T NIL)))
(COND
((EQ BEHIND (QUOTE BOTH))
(CONS TEMPADDR ADDR2))
(BEHIND ADDR2)
(T TEMPADDR)))
(T NIL)))
(T (SETQ TEMPADDR (TXDTBOX ADDR1 OLDBOX))
(COND
((for I from 1 to (NCHARS STR) by 1
always (COND
((TXDTEQUAL TEMPADDR ADDR2)
NIL)
((EQ (NTHCHAR STR I)
(TXDTCHAR TEMPADDR NIL 1))
T)
(T NIL)))
(COND
((EQ BEHIND (QUOTE BOTH))
(CONS ADDR1 TEMPADDR))
(BEHIND TEMPADDR)
(T ADDR1)))
(T NIL])
(TXDTBOX
[LAMBDA (ADDR BOUNDARYERRFLG OLDBOX SPECIALBTMFLG)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR (AND BOUNDARYERRFLG (QUOTE
BOUNDARYERR)))
(COND
((AND SPECIALBTMFLG (BTMRECP REC))
(* If this flg is on and the decoded address is the btm, then move up one
char and box the resulting address with the special mark
(SPECIAL-BTM-MARK rec . pos))
(EDITMOVEC 1 REC POS T)
(SETQ REC (CONS (QUOTE SPECIAL-BTM-MARK)
(CONS EDITMOVECREC EDITMOVECPOS)))
(SETQ POS 0)))
(RETURN (TXDTBOXRECPOS REC POS OLDBOX])
(TXDTBOXRECPOS
[LAMBDA (REC POS OLDBOX)
(* if OLDBOX is NIL it constructs a new box and puts REC,POS in it.
If OLDBOX is non-NIL it is assumed to be a TXDTADDRP and is munged.
Resulting box is returned.)
[COND
((TYPE? TXDTADDR OLDBOX)
(replace TXDTREC of OLDBOX with REC)
(replace TXDTPOS of OLDBOX with POS))
(T (SETN TXDTADDRCNT (ADD1 TXDTADDRCNT))
(SETQ OLDBOX (create TXDTADDR TXDTREC _ REC TXDTPOS _ POS]
OLDBOX])
(TXDTBREAKLOCKS
[LAMBDA NIL
(* In cases of emergency, such as after errors have interupted processes
which established locks, this function is used to break all existing locks.
It may produce errors if processes above the error set the locks, but they
don't have a great deal of business carrying on after errors.
This function is only called by those function with errsets in them that
set locks.)
(SETN TXDTPAGE1LOCK 0)
(SETN TXDTPAGE2LOCK 0])
(TXDTCHAR
[LAMBDA (ADDR CHARCODEFLG MOVEFLG)
|
(* returns the character at ADDR and destructively advances ADDR to the next or prev char depending on BACKWARDS.
If CHARCODEFLG is set the numeric code for the char is retured, otherwise the atom consisting of the single char is
returned. CR/LF is returned as EOL and the ADDR is advanced two steps.)
|
|
(* An ADDR equivalent to TOP for its buffer is treated specially when we are supposed to move backwards.
After the char is fetched, the ADDR is smashed so that its TXDTREC is the toprec of the buffer and its TXDTPOS is
-1; On entry to this function such addresses are caught and the value NIL is returned. In addition, if moving
forward the ADDR is again modified, to be equivalent to TOP again.)
(PROG NIL
(COND
((AND (type? TXDTADDR ADDR)
(TOPRECP (fetch TXDTREC of ADDR)))
(* Ok, this is a specially marked address representing a move off the top of the buffer. We will return NIL as the
char at this position, and if we are to move forward, we will smash the address to be at the top of the buffer
again, using the knowledge that its TXDTREC is the toprec of this buffer.)
[COND
((AND MOVEFLG (NEQ MOVEFLG -1))
(replace TXDTREC of ADDR with (fetch TXDTNEXT of (fetch TXDTREC of ADDR)))
(replace TXDTPOS of ADDR with (fetch TXDTOFFSET1 of (fetch TXDTREC of ADDR]
(RETURN NIL)))
(TXDTSETQQ EDITCHARREC EDITCHARPOS ADDR) (* unbox the address into the globals EDITCHAR will hit)
(COND
((BTMRECP EDITCHARREC)
(COND
((AND (EQ MOVEFLG -1)
(TXDTADDRP ADDR))
(EDITCHAR EDITCHARREC 0 T)
(TXDTBOXRECPOS EDITCHARREC EDITCHARPOS ADDR)))
(RETURN NIL)))
(EDITCHAR EDITCHARREC EDITCHARPOS (EQ MOVEFLG -1))
[COND
((AND MOVEFLG (TXDTADDRP ADDR))
(* if we are to move the address, and if ADDR is a boxed REC,POS then destructively alter it to the next/prev char
defind by EDITCHAR)
(COND
([AND (EQ MOVEFLG -1)
(TOPRECP (fetch TXDTPREV of (fetch TXDTREC of ADDR)))
(IEQP (fetch TXDTPOS of ADDR)
(fetch TXDTOFFSET1 of (fetch TXDTREC of ADDR]
(* If we are moving backwards and ADDR is currently at the TOP of its buffer -- i.e., its TXDTREC is the one
following a toprec and its TXDTPOS is the offset1 of that TXDTREC -- then we want to smash ADDR so that it looks
like we have moved off of top.)
(replace TXDTREC of ADDR with (fetch TXDTPREV of (fetch TXDTREC of ADDR)))
(replace TXDTPOS of ADDR with -1))
(T (TXDTBOXRECPOS EDITCHARREC EDITCHARPOS ADDR]
(RETURN (COND
((NULL EDITCHARCODE)
(* If for any reason -- i.e., EDITCHAR was called on the btm rec -- the char code is NIL, return NIL This isn't
supposed to happen. That is, while EDITCHAR might be called on btm by this fn, we process that call specially.
However, EDITCHAR does return NIL on top and btm and I thought it would be a good idea to catch it just in case.)
NIL)
(CHARCODEFLG EDITCHARCODE)
(T (CHARACTER EDITCHARCODE])
(TXDTCLOSEALL
[LAMBDA NIL (* closes all files on EDITREADFILELST)
(EDITCLOSEALL])
(TXDTCLOSEF
[LAMBDA (FILENAME)
(* un-PMAPs and closes FILENAME. If its a number, its treated as a JFN.)
(EDITCLOSEF FILENAME])
(TXDTCLOSEST
[LAMBDA (ADDR ADDRLST) (* Returns the address on ADDRLST which
is closest to ADDR)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR)
(RETURN (EDITCLOSEST REC POS (for ADDR in ADDRLST
collect (TXDTSETQQ REC POS
ADDR)
(CONS REC
(CONS POS ADDR])
(TXDTCONTIGIFY
[LAMBDA (ADDR1 ADDR2 FILE BEHIND OLDBOX)
(* writes from ADDR1 to ADDR2 to FILE, the deletes it and inserts the file
segment. Returns the same addr as TXDTINSERT would given BEHIND.)
(PROG (REC1 REC2 POS1 POS2 STARTPOS)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((EDITCONTIGP REC1 POS1 REC2 POS2)
(SETQ EDITINSERTREC1 REC1)
(SETQ EDITINSERTPOS1 POS1)
(SETQ EDITINSERTREC2 REC2)
(SETQ EDITINSERTPOS2 POS2)
(GO EXIT)))
(SETQ FILE (COND
(FILE (OR (OPENP FILE (QUOTE BOTH))
(IOFILE FILE)))
(T TXDTSCRATCHFILE)))
(SETQ STARTPOS (GETFILEPTR FILE))
(EDITPRINT REC1 POS1 REC2 POS2 NIL NIL (OPNJFN FILE))
(EDITDELETE REC1 POS1 REC2 POS2)
(EDITINSERT (CONS FILE (CONS STARTPOS (GETFILEPTR FILE)))
EDITDELETEREC EDITDELETEPOS)
EXIT(RETURN (COND
((EQ BEHIND (QUOTE BOTH))
(CONS (TXDTBOXRECPOS EDITINSERTREC1
EDITINSERTPOS1 OLDBOX)
(TXDTBOXRECPOS EDITINSERTREC2
EDITINSERTPOS2)))
(BEHIND (TXDTBOXRECPOS EDITINSERTREC2
EDITINSERTPOS2 OLDBOX))
(T (TXDTBOXRECPOS EDITINSERTREC1 EDITINSERTPOS1
OLDBOX])
(TXDTCONTIGP
[LAMBDA (ADDR1 ADDR2 OLDCONS)
(* If the text between the two addresses is represented contiguously on a file record, return the pair
(FILE . POS) indicating where it starts. Else, return NIL.)
(PROG (REC1 POS1 REC2 POS2 NBOX)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((EDITCONTIGP REC1 POS1 REC2 POS2)
(OR (LISTP OLDCONS)
(SETQ OLDCONS (CONS NIL NIL)))
(SETQ NBOX|(CDR OLDCONS))
(RPLACA OLDCONS (JFNS (LRSH (SETN TXDTTEMPSOURCEBOX (fetch TXDTSOURCE of REC1))
18)))
(SETN NBOX|(IPLUS (ITIMES 2560 (LOGAND TXDTTEMPSOURCEBOX 262143))
POS1 1500)) |
(RPLACD OLDCONS NBOX)
(RETURN OLDCONS))
(T (RETURN NIL])
(TXDTCOPY
[LAMBDA (X) (* copies an addr or grabbed object)
(PROG (REC POS)
(COND
((SETQ REC (TXDTGRABBEDP X))
(* if its a grabbed object)
(COND
((EQ REC (QUOTE GRABBED&INSERTED))
(* and if its been inserted, error)
(ERROR "CANNOT COPY INSERTED GRABBED OBJECT" X)
(ERROR!))
((EQ REC (QUOTE GRABBED&UNDONE))
(* X is the result of an undone grab, which means the chain in it is
inserted.)
(ERROR "CANNOT COPY RESULT OF AN UNDONE GRAB" X)
(ERROR!)))
(SETN TXDTGRABBEDOBJCNT (ADD1 TXDTGRABBEDOBJCNT))
(SETQ X (create TXDTGRABBEDOBJ TXDTCHAIN _(
EDITCOPYGRABBED (fetch TXDTCHAIN
of X))
TXDTGRABFLG _(QUOTE GRABBED)))
(RETURN X))
(T (* if its not a grabbed object, treat it
as an address)
(COND
((NOT (XNLSETQ (TXDTSETQQ REC POS X)
NOBREAK))
(ERROR "CANNOT COPY INVALID ADDRESS" X)
(ERROR!)))
(RETURN (TXDTBOXRECPOS REC POS])
(TXDTCOUNTLC
[LAMBDA (ADDR1 ADDR2 COUNTLCFLG)
(* Counts the number of lines and/or chars between ADDR1 and ADDR2.
If COUNTLCFLG is NIL, this fn is a non-op! If the flag is CHARS it counts
the characters. If the flag is LINES it counts the lines.
If the flag is BOTH it counts the no of lines and the no of chars from the
beginning of the last line to ADDR2 and returns a dotted pair of form
(lines . chars))
(PROG (REC1 POS1 REC2 POS2)
(COND
((NULL COUNTLCFLG)
(RETURN NIL)))
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(EDITCOUNTLC REC1 POS1 REC2 POS2 (EQ COUNTLCFLG (QUOTE CHARS))
)
(RETURN (COND
((EQ COUNTLCFLG (QUOTE CHARS))
EDITCOUNTC)
((EQ COUNTLCFLG (QUOTE LINES))
EDITCOUNTL)
(T (CONS EDITCOUNTL EDITCOUNTC])
(TXDTCOUNTPIECES
[LAMBDA (ADDR1 ADDR2) (* counts number of records from ADDR1
to (and including) ADDR2.)
(PROG (REC1 POS1 REC2 POS2 ANS)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(SETQ ANS 1)
LOOP(COND
((OR (EQ REC1 REC2)
(BTMRECP REC1))
(RETURN ANS)))
(SETQ ANS (ADD1 ANS))
(SETQ REC1 (fetch TXDTNEXT of REC1))
(GO LOOP])
(TXDTCURBUF
[LAMBDA (BUF UNDOABLY DEFAULTFLG TOPMSG)
(PROG (TXDTPOETFLG TEMPTOP TEMPBTM TEMPPOETDOT TEMPPOETDOTADDR
TEMP$)
(SETQ TXDTEOLPNOTINTERRUPTED NIL)
[COND
[BUF
(* Then assume buf is a valid buf record and set the vars accordingly.)
(SETQ TEMPTOP (fetch TXDTTOP of BUF))
(COND
((EQ TEMPTOP (QUOTE KILLED))
(ERROR "CAN'T REINSTATE A KILLED BUFFER" BUF)))
(SETQ TEMPBTM (fetch TXDTBTM of BUF))
(SETQ TEMPPOETDOT (AND (NOT DEFAULTFLG)
(fetch TXDTPOETDOT
of BUF)))
(SETQ TEMPPOETDOTADDR (AND (NOT DEFAULTFLG)
(fetch TXDTPOETDOTADDR
of BUF)))
(SETQ TEMP$ (AND (NOT DEFAULTFLG)
(fetch TXDT$ of BUF]
(T (SETN TXDTRECORDCNT (IPLUS TXDTRECORDCNT 2))
(SETQ TEMPTOP
(create TXDTRECORD TXDTSOURCE _ -1 TXDTOFFSET1 _ 0
TXDTOFFSET2 _ 35 TXDTPREV _ NIL TXDTNEXT _ NIL
TXDTMSG _ TOPMSG))
(SETQ TEMPBTM
(create TXDTRECORD TXDTSOURCE _ -2 TXDTOFFSET1 _ 0
TXDTOFFSET2 _ 35 TXDTPREV _ TEMPTOP TXDTNEXT _
NIL))
(replace TXDTPREV of TEMPTOP with TEMPTOP)
(replace TXDTNEXT of TEMPTOP with TEMPBTM)
(replace TXDTNEXT of TEMPBTM with TEMPBTM)
(SETN TXDTBUFFERCNT (ADD1 TXDTBUFFERCNT))
(SETQ BUF
(create TXDTBUFFER TXDTTOP _ TEMPTOP TXDTBTM _ TEMPBTM
TXDTPOETDOT _ NIL TXDTPOETDOTADDR _ NIL TXDT$
_ NIL]
(COND
(UNDOABLY (/SET (QUOTE TOPREC)
TEMPTOP)
(/SET (QUOTE BTMREC)
TEMPBTM))
(T (SETQ TOPREC TEMPTOP)
(SETQ BTMREC TEMPBTM)))
(COND
((NULL TEMP$)
(EDITCOUNTLC (fetch TXDTNEXT of TEMPTOP)
(fetch TXDTOFFSET1
of (fetch TXDTNEXT of TEMPTOP))
TEMPBTM 0 NIL)
(SETQ TEMP$ EDITCOUNTL)
(replace TXDT$ of BUF with TEMP$)))
(COND
((NULL TEMPPOETDOT)
[SETQ TEMPPOETDOT (COND
((ZEROP TEMP$)
(CONS 1 1))
(T (CONS TEMP$ 1]
(replace TXDTPOETDOT of BUF with TEMPPOETDOT)
(SETQ TEMPPOETDOTADDR NIL)))
(COND
((NULL TEMPPOETDOTADDR)
(SETQ TEMPPOETDOTADDR (TXDTBOX TEMPPOETDOT))
(replace TXDTPOETDOTADDR of BUF with TEMPPOETDOTADDR)))
(COND
(UNDOABLY (/SET (QUOTE TXDTPOETDOT)
TEMPPOETDOT)
(/SET (QUOTE TXDTPOETDOTADDR)
TEMPPOETDOTADDR)
(/SET (QUOTE TXDT$)
TEMP$))
(T (SETQ TXDTPOETDOT TEMPPOETDOT)
(SETQ TXDTPOETDOTADDR TEMPPOETDOTADDR)
(SETQ TXDT$ TEMP$)))
(OR (MEMB BUF TXDTCURBUFLST)
(SETQ TXDTCURBUFLST (CONS BUF TXDTCURBUFLST)))
(RETURN (SETQ TXDTCURBUF BUF])
(TXDTDELETE
[LAMBDA (ADDR1 ADDR2 COUNTLCFLG OLDBOX)
(* deletes the text from ADDR1 to -- not thru -- ADDR2 and counts lines or
chars deleted if COUNTLCFLG is set. Sets TXDTDELTA to negative of value of
TXDTCOUNTLC with same flag, unless COUNTLCFLG is NIL in which case
TXDTDELTA is not changed. If flag is BOTH, both CAR and CDR is negative.)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((NULL (XNLSETQ (EDITDELETE REC1 POS1 REC2 POS2 COUNTLCFLG)
NOBREAK))
(ERROR "ILL-DEFINED WINDOW" (LIST ADDR1 ADDR2))
(ERROR!)))
(RETURN (TXDTBOXRECPOS EDITDELETEREC EDITDELETEPOS OLDBOX])
(TXDTEMPTYP
[LAMBDA (BUF)
(COND
[BUF (OR (EQ (fetch TXDTTOP of BUF)
(QUOTE KILLED))
(EQ (fetch TXDTNEXT of (fetch TXDTTOP of BUF))
(fetch TXDTBTM of BUF]
(T (EQ (fetch TXDTNEXT of TOPREC)
BTMREC])
(TXDTEOLP
[LAMBDA NIL
(COND
([AND TXDTEOLPNOTINTERRUPTED [IEQP TXDTEOLPTEXT (SETN TXDTTEMPSOURCEBOX
(fetch TXDTSOURCE
of (fetch TXDTPREV of BTMREC]
(IEQP TXDTEOLPOFFSET2 (fetch TXDTOFFSET2 of (fetch TXDTPREV of BTMREC]
TXDTEOLPANS)
(T (PROG (PREVBTMREC)
(SETQ TXDTEOLPNOTINTERRUPTED NIL)
[SETN TXDTEOLPTEXT (fetch TXDTSOURCE of (SETQ PREVBTMREC (fetch TXDTPREV of BTMREC]
(SETQ TXDTEOLPOFFSET2 (fetch TXDTOFFSET2 of PREVBTMREC))
[SETQ TXDTEOLPANS (COND
((TOPRECP PREVBTMREC)
NIL)
(T (EQ 31 (EDITCHAR PREVBTMREC (SUB1 TXDTEOLPOFFSET2)
T]
(SETQ TXDTEOLPNOTINTERRUPTED T)
(RETURN TXDTEOLPANS])
(TXDTEQUAL
[LAMBDA (ADDR1 ADDR2) (* equality test for TXDT addrs)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 ADDR1)
(TXDTSETQQ REC2 POS2 ADDR2)
(RETURN (AND (EQ REC1 REC2)
(IEQP POS1 POS2])
(TXDTFILEPOSITION
[LAMBDA (ADDR OLDCONS)
(PROG (REC POS NBOX)
(COND
((NOT (XNLSETQ (TXDTSETQQ REC POS ADDR (QUOTE BOUNDARYERR))
NOBREAK)) |
(RETURN NIL)))
(SETN TXDTTEMPSOURCEBOX (fetch TXDTSOURCE of REC))
(OR (LISTP OLDCONS)
(SETQ OLDCONS (CONS NIL NIL)))
(RPLACA OLDCONS (JFNS (LRSH TXDTTEMPSOURCEBOX 18)))
(SETQ NBOX (CDR OLDCONS))
(SETN NBOX (IPLUS (ITIMES 2560 (LOGAND TXDTTEMPSOURCEBOX 262143))
POS 1500))
(RPLACD OLDCONS NBOX)
(RETURN OLDCONS])
(TXDTFIND
[LAMBDA (STR ADDR1 ADDR2 BACKWARDS BEHIND COUNT ANCHOR OLDBOX)
(* returns addr of COUNTth occurrence of STR in window, searching BACKWARDS
if desired. Address returned is of beginning or end depending on BEHIND.
If BEHIND is BOTH, the two addrs are consed together and returned.)
(PROG (REC1 POS1 REC2 POS2)
[COND
(ANCHOR (RETURN (TXDTANCHOREDFIND STR ADDR1 ADDR2 BACKWARDS
BEHIND OLDBOX]
(OR (STRINGP STR)
(SETQ STR (MKSTRING STR)))
[COND
((NULL COUNT)
(SETQ COUNT 1))
((MINUSP COUNT)
(SETQ COUNT (ABS COUNT))
(SETQ BACKWARDS (NOT BACKWARDS]
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(RETURN (COND
[(EDITSEARCH STR REC1 POS1 REC2 POS2 BACKWARDS
COUNT)
(COND
((EQ BEHIND (QUOTE BOTH))
(OR (LISTP OLDBOX)
(SETQ OLDBOX (CONS NIL NIL)))
(RPLACA OLDBOX (TXDTBOXRECPOS EDITSEARCHREC1
EDITSEARCHPOS1
OLDBOX))
(RPLACD OLDBOX (TXDTBOXRECPOS EDITSEARCHREC2
EDITSEARCHPOS2))
OLDBOX)
(BEHIND (TXDTBOXRECPOS EDITSEARCHREC2
EDITSEARCHPOS2 OLDBOX))
(T (TXDTBOXRECPOS EDITSEARCHREC1 EDITSEARCHPOS1
OLDBOX]
(T NIL])
(TXDTFREESPACE
[LAMBDA (UNDOABLY)
(MAPC (QUOTE (EDITCHARREC EDITDELETEREC EDITGOTOREC EDITINSERTREC1
EDITINSERTREC2 EDITMOVECREC EDITMOVELREC
EDITSEARCHREC1 EDITSEARCHREC2
EDITCLOSESTLST))
(FUNCTION (LAMBDA (VAR)
(COND
(UNDOABLY (/SET VAR (QUOTE NOBIND)))
(T (SET VAR (QUOTE NOBIND])
(TXDTGETMSG
[LAMBDA (ADDR)
(PROG (REC POS)
[COND
((type? TXDTBUFFER ADDR)
(SETQ REC (fetch TXDTTOP of ADDR)))
(T (TXDTSETQQ REC POS ADDR)
(COND
((BTMRECP REC)
(SETQ REC (fetch TXDTPREV of REC]
(RETURN (fetch TXDTMSG of REC])
(TXDTGETMSGLST
[LAMBDA (ADDR1 ADDR2)
(PROG (REC1 POS1 REC2 POS2 ANS MSG CHARCNT)
(OR ADDR1 (SETQ ADDR1 (QUOTE TOP)))
(OR ADDR2 (SETQ ADDR2 (QUOTE BTM)))
(TXDTSETQQ REC1 POS1 ADDR1)
(TXDTSETQQ REC2 POS2 ADDR2)
(SETQ ANS (fetch TXDTNEXT of (GETTOPREC REC1)))
(EDITCOUNTLC ANS (fetch TXDTOFFSET1 of ANS)
REC1 POS1 T)
(SETQ CHARCNT (ADD1 EDITCOUNTC))
(SETQ ANS NIL)
LOOP(COND
((BTMRECP REC1)
(RETURN ANS)))
(SETQ MSG (fetch TXDTMSG of REC1))
[COND
([AND MSG (OR (NEQ REC1 REC2)
(NOT (IEQP POS2 (fetch TXDTOFFSET1
of REC2]
(SETQ ANS (NCONC1 ANS (CONS (CONS NIL CHARCNT)
MSG]
(COND
((EQ REC1 REC2)
(RETURN ANS)))
(SETQ CHARCNT (IPLUS CHARCNT (IDIFFERENCE (fetch TXDTOFFSET2
of REC1)
POS1)))
(SETQ REC1 (fetch TXDTNEXT of REC1))
(SETQ POS1 (fetch TXDTOFFSET1 of REC1))
(GO LOOP])
(TXDTGETNEWJFN
[LAMBDA (OLDJFN)
(PROG (NEWJFN)
LOOP(SETQ NEWJFN (HELP
"ATTEMPT TO PMAP IN A PAGE FROM AN INVALID JFN
RETURN a good jfn to be used in place of the invalid one, or
STOP.
Invalid jfn:" OLDJFN))
(COND
((NOT (SMALLP NEWJFN))
(GO LOOP)))
(RETURN NEWJFN])
(TXDTGOTO
[LAMBDA (LINENO CHARNO FLG OLDBOX) (* Returns addr of LINENOth line and
CHARNOth char.)
(EDITGOTO LINENO CHARNO FLG)
(COND
(EDITGOTOREC (* if ans ok, box it)
(TXDTBOXRECPOS EDITGOTOREC EDITGOTOPOS OLDBOX))
(T NIL])
(TXDTGRAB
[LAMBDA (ADDR1 ADDR2 COUNTLCFLG OLDBOX)
(* grabs the text between the two addresses exactly like delete.
Returns the grabbed text and sets TXDTGRABADDR to the boxed address of the
end of the deleted window. Counts text grabbed if COUNTLCFLG, just as
delete does.)
(PROG (REC1 POS1 REC2 POS2 ANS)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((NULL (XNLSETQ (SETQ ANS (EDITGRAB REC1 POS1 REC2 POS2
COUNTLCFLG))
NOBREAK))
(ERROR "ILL-DEFINED WINDOW" (LIST ADDR1 ADDR2))
(ERROR!)))
(SETQ TXDTGRABADDR (TXDTBOXRECPOS EDITDELETEREC EDITDELETEPOS
OLDBOX))
(SETN TXDTGRABBEDOBJCNT (ADD1 TXDTGRABBEDOBJCNT))
(SETQ ANS (create TXDTGRABBEDOBJ TXDTCHAIN _ ANS TXDTGRABFLG
_(QUOTE GRABBED&UNDONE)))
(/replace TXDTGRABFLG of ANS with (QUOTE GRABBED))
(* This is done so that if the grab is undone, the object the user is
holding is no longer marked as GRABBED.)
(RETURN ANS])
(TXDTGRABBEDP
[LAMBDA (X)
(TYPE? TXDTGRABBEDOBJ X])
(TXDTGREATERP
[LAMBDA (ADDR1 ADDR2) (* returns T iff ADDR1 occurs downstream
of ADDR2)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 ADDR1)
(TXDTSETQQ REC2 POS2 ADDR2)
(RETURN (EDITGREATERP REC1 POS1 REC2 POS2])
(TXDTINIT
[LAMBDA NIL |
[COND |
((NULL (GETFIELDSPECS (QUOTE TXDTRECORD)))
(DATATYPE TXDTRECORD ((TXDTSOURCE FIXP)
TXDTOFFSET1 TXDTOFFSET2 TXDTNEXT TXDTPREV TXDTSPLITRECS TXDTMSG))
(DATATYPE TXDTADDR (TXDTREC (TXDTPOS INTEGER)))
(DATATYPE TXDTGRABBEDOBJ (TXDTCHAIN TXDTGRABFLG))
(DATATYPE TXDTBUFFER (TXDTTOP TXDTBTM TXDTPOETDOT TXDTPOETDOTADDR TXDT$]
[AND TXDTSCRATCHFILE (NOT (OPENP TXDTSCRATCHFILE (QUOTE BOTH)))
(SETQ TXDTSCRATCHFILE (IOFILE (CLOSEF (OUTPUT (OUTFILE (COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(QUOTE TXDTSCRATCHFILE.TXT;-1;T))
(T (QUOTE TXDTSCRATCHFILE.TXT.-1;T]
(SETQ TXDTEOLPNOTINTERRUPTED NIL)
(COND |
((EQ (GETTOPVAL (QUOTE TXDTPAGE1))
(QUOTE NOBIND))
(SETQ TXDTPAGE1 (GETBLK 1))
(SETQ TXDTPAGE2 (GETBLK 1))
(SETN TXDTPAGE1CONTENTS -1)
(SETN TXDTPAGE2CONTENTS -1)
(SETN TXDTPAGE1CNT 0)
(SETN TXDTPAGE2CNT 0)
(SETN TXDTPAGE1LOCK 0)
(SETN TXDTPAGE2LOCK 0))
(T (SWAPOUT TXDTPAGE1)
(SWAPOUT TXDTPAGE2)))
(SETQ TXDTRESETFORMBREAKLOCKSFLG NIL)
(TXDTFREESPACE)
(TXDTKILLBUF (QUOTE ALL))
(EDITCLOSEALL)
(TXDTCURBUF NIL)
(SETN TXDTSWAPCNT 0])
(TXDTINSERT
[LAMBDA (OBJ ADDR BEHIND COUNTLCFLG OLDBOX)
(* Inserts OBJ immediately after ADDR and returns the address of the
beginning or end of the insertion, depending on BEHIND.
If OBJ is a string, the obvious chars are inserted.
If OBJ is a grabbed object properly marked it is unmarked and inserted.
If OBJ is a list it is assumed to denote a file window.
If OBJ is a litatom, it is assumed to denote a file.
If anything else, it is converted to a string. If a grabbed object or a
list or litatom doesn't meet the requirements imposed, an error is caused
and all modifications are undone. If COUNTLCFLG is non-NIL, the number of
lines/chars, as determined by TXDTCOUNTLC, is computed and stored in
TXDTDELTA.)
(PROG (REC POS)
(TXDTSETQQ REC POS (OR ADDR (QUOTE TOP)))
(* unbox the address, defaulting to the
top, and put it in REC,POS)
(EDITINSERT OBJ REC POS COUNTLCFLG)
(* insert OBJ)
(RETURN (COND
((EQ BEHIND (QUOTE BOTH))
(CONS (TXDTBOXRECPOS EDITINSERTREC1
EDITINSERTPOS1 OLDBOX)
(TXDTBOXRECPOS EDITINSERTREC2
EDITINSERTPOS2)))
(BEHIND (TXDTBOXRECPOS EDITINSERTREC2
EDITINSERTPOS2 OLDBOX))
(T (TXDTBOXRECPOS EDITINSERTREC1 EDITINSERTPOS1
OLDBOX])
(TXDTKILLBUF
[LAMBDA (BUF UNDOABLY EVEN-IF-CURRENT-FLG)
(* Kills BUF. That is, it deletes the text between its top and btm, resets
the current buf globals if buf is current, removes buf from the buf list,
and smashes buf's components with the work KILLED.)
(COND
((EQ BUF (QUOTE ALL))
(SETQ BUF (APPEND TXDTCURBUFLST))
(SETQ EVEN-IF-CURRENT-FLG T)))
(COND
((OR (LISTP BUF)
(NULL BUF))
(for X in BUF do (TXDTKILLBUF X UNDOABLY EVEN-IF-CURRENT-FLG))
(QUOTE KILLED))
(T (PROG ((LISPXHISTORY LISPXHISTORY))
(OR UNDOABLY (SETQ LISPXHISTORY NIL))
[COND
((EQ BUF TXDTCURBUF)
(COND
((NOT EVEN-IF-CURRENT-FLG)
(ERROR
"CAN'T KILL CURRENT BUFFER WITHOUT EXPRESS PERMISSION" BUF)
))
(/SET (QUOTE TXDTCURBUF)
(QUOTE KILLED))
(/SET (QUOTE TOPREC)
(QUOTE KILLED))
(/SET (QUOTE BTMREC)
(QUOTE KILLED))
(/SET (QUOTE TXDTPOETDOT)
(QUOTE KILLED))
(/SET (QUOTE TXDTPOEDDOTADDR)
(QUOTE KILLED))
(/SET (QUOTE TXDT$)
(QUOTE KILLED]
(OR (EQ (FETCH TXDTTOP OF BUF)
(QUOTE KILLED))
(EDITDELETE (fetch TXDTNEXT
of (fetch TXDTTOP of BUF))
(fetch TXDTOFFSET1
of (fetch TXDTTOP of BUF))
(fetch TXDTBTM of BUF)
0))
[/SET (QUOTE TXDTCURBUFLST)
(COND
(UNDOABLY (REMOVE BUF TXDTCURBUFLST))
(T (DREMOVE BUF TXDTCURBUFLST]
(/replace TXDTTOP of BUF with (QUOTE KILLED))
(/replace TXDTBTM of BUF with (QUOTE KILLED))
(/replace TXDTPOETDOT of BUF with (QUOTE KILLED))
(/replace TXDTPOETDOTADDR of BUF with (QUOTE KILLED))
(/replace TXDT$ of BUF with (QUOTE KILLED))
(* This second smash is so that the recs can be gc'd if no one else points
to them.)
(RETURN (QUOTE KILLED])
(TXDTMAPCHARS
[LAMBDA (ADDR1 ADDR2 ASCIIFLG MOVEFLG UNTILFN)
(PROG (REC1 POS1 REC2 POS2)
[COND
[(AND (type? TXDTADDR ADDR1)
(TOPRECP (fetch TXDTREC of ADDR1)))
(SETQ REC1 (fetch TXDTNEXT of (fetch TXDTREC
of ADDR1)))
(SETQ POS1 (fetch TXDTOFFSET1 of REC1))
(COND
((APPLY* UNTILFN NIL)
(RETURN (TXDTBOXRECPOS REC1 POS1 ADDR1]
(T (TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP]
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((EDITMAPCHARS REC1 POS1 REC2 POS2 ASCIIFLG
(EQ MOVEFLG -1)
UNTILFN)
(COND
((AND (EQ MOVEFLG -1)
(TOPRECP (fetch TXDTPREV of EDITCHARREC)))
(SETQ EDITCHARREC (fetch TXDTPREV of EDITCHARREC))
(SETQ EDITCHARPOS -1)))
(RETURN (TXDTBOXRECPOS EDITCHARREC EDITCHARPOS ADDR1)))
(T (TXDTBOXRECPOS EDITCHARREC EDITCHARPOS ADDR1)
(RETURN NIL])
(TXDTMAPMSG
[LAMBDA (ADDR1 ADDR2 FN ARG2)
(PROG (REC1 POS1 REC2 POS2 MSG)
[COND
((NULL FN)
(RETURN (TXDTGETMSGLST ADDR1 ADDR2]
(OR ADDR1 (SETQ ADDR1 (QUOTE TOP)))
(OR ADDR2 (SETQ ADDR2 (QUOTE BTM)))
(TXDTSETQQ REC1 POS1 ADDR1)
(COND
((NOT (IEQP POS1 (fetch TXDTOFFSET1 of REC1)))
(EDITINSERT NIL REC1 POS1)
(SETQ REC1 EDITINSERTREC2)
(SETQ POS1 EDITINSERTPOS2)))
(TXDTSETQQ REC2 POS2 ADDR2)
[COND
((NOT (IEQP POS2 (fetch TXDTOFFSET1 of REC2)))
(SETQ REC1 (fetch TXDTPREV of REC1))
(EDITINSERT NIL REC2 POS2)
(SETQ REC2 EDITINSERTREC2)
(SETQ POS2 EDITINSERTPOS2)
(SETQ REC1 (fetch TXDTNEXT of REC1]
LOOP(COND
((OR (EQ REC1 REC2)
(BTMRECP REC1))
(RETURN NIL)))
(SETQ MSG (APPLY* FN (fetch TXDTMSG of REC1)
ARG2))
(COND
([OR (EQ MSG 0)
(COND
((LISTP MSG)
(OR [for TAIL on MSG
thereis (OR (NEQ 1 (NCHARS (CAR TAIL)))
(AND (NLISTP (CDR TAIL))
(CDR TAIL]
(IGREATERP (LENGTH MSG)
127)))
((NULL MSG)
NIL)
(T (NEQ 1 (NCHARS MSG]
(ERROR "ATTEMPT TO INSERT ILLEGAL MESSAGE!" MSG)))
(/replace TXDTMSG of REC1 with MSG)
(SETQ REC1 (fetch TXDTNEXT of REC1))
(GO LOOP])
(TXDTMKSTRING
[LAMBDA (ADDR1 ADDR2 RPLSTRING STRPTR BITMASK)
(* makes a string containing the text in the window ADDR1 -
ADDR2. If RPLSTRING is a string, chars are written into it.
If RPLSTRING is NIL TXDTSCRATCHSTRING is used and copied when finished.
If RPLSTRING is T, TXDTSCRATCHSTRING is used and not recopied.
If STRPTR is a string pointer it is smashed to substring the buffer holding
the chars. If STRPTR is NIL a new one is created. Skips any char c such
that cth bit in BITMASK is on.)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(RETURN (EDITMKSTRING REC1 POS1 REC2 POS2 RPLSTRING
(COND
((STRINGP RPLSTRING)
RPLSTRING)
(T TXDTSCRATCHSTRING))
STRPTR BITMASK])
(TXDTMOVE
[LAMBDA (LINEDIST CHARDIST ADDR FLG OLDBOX)
(* moves LINEDIST lines and then CHARDIST chars with defaults as spec by
EDITMOVE.)
(PROG (REC POS)
[TXDTSETQQ REC POS (OR ADDR (COND
[LINEDIST (COND
((ILESSP LINEDIST 0)
(QUOTE BTM))
(T (QUOTE TOP]
[CHARDIST (COND
((ILESSP CHARDIST 0)
(QUOTE BTM))
(T (QUOTE TOP]
(T (QUOTE TOP]
(EDITMOVE LINEDIST CHARDIST REC POS FLG)
(RETURN (COND
(EDITMOVECREC (TXDTBOXRECPOS EDITMOVECREC
EDITMOVECPOS OLDBOX))
(T NIL])
(TXDTNEXTPIECE
[LAMBDA (ADDR OLDBOX)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR)
(RETURN (TXDTBOXRECPOS (fetch TXDTNEXT of REC)
(fetch TXDTOFFSET1 of (fetch TXDTNEXT of REC))
OLDBOX])
(TXDTPIECE
[LAMBDA (ADDR OLDBOX)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR)
(RETURN (TXDTBOXRECPOS REC (fetch TXDTOFFSET1 of REC)
OLDBOX])
(TXDTPREVPIECE
[LAMBDA (ADDR OLDBOX)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR)
(SETQ REC (fetch TXDTPREV of REC))
(RETURN (COND
((TOPRECP REC)
(TXDTBOXRECPOS (fetch TXDTNEXT of REC)
(fetch TXDTOFFSET1 of (fetch TXDTNEXT of REC))
OLDBOX))
(T (TXDTBOXRECPOS REC (fetch TXDTOFFSET1 of REC)
OLDBOX])
(TXDTPRINT
[LAMBDA (ADDR1 ADDR2 PTRADDR PTRCHAR DESTJFN BITMASK)
(* Prints the chars between first two ADDRs to DESTJFN or tty.
If PTRADDR is an address, PTRCHAR or TXDTPTRCHAR is printed immediately
before the denoted by the address. If PTRADDR is a list of addresses, the
corresponding members of PTRCHAR -- or TXDTPTRCHAR if PTRCHAR is NIL -- are
printed at each address. Will not print any char c such that cth bit of
BITMASK is on.)
(PROG (REC1 POS1 REC2 POS2 PTRREC PTRPOS)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
[COND
(PTRADDR
(* if PTRADDR is non-NIL unbox it. Otherwise just leave PTRREC NIL and
things will take care of themselves)
[SETQ PTRADDR
(COND
([AND (LISTP PTRADDR)
(OR (LISTP (CDR PTRADDR))
(EQ NIL (CDR PTRADDR]
(for PTRADDR in PTRADDR
collect (TXDTSETQQ PTRREC PTRPOS PTRADDR)
(CONS PTRREC PTRPOS)))
(T (TXDTSETQQ PTRREC PTRPOS PTRADDR)
(LIST (CONS PTRREC PTRPOS]
(SETQ PTRCHAR (OR PTRCHAR TXDTPTRCHAR]
(RETURN (CHARACTER (EDITPRINT REC1 POS1 REC2 POS2 PTRADDR
PTRCHAR (OR DESTJFN 65)
BITMASK])
(TXDTPRINTUSERFN
[LAMBDA (MSG JFN)
NIL])
(TXDTPUTMSG
[LAMBDA (ADDR MSG)
(PROG (REC POS)
(COND
((type? TXDTBUFFER ADDR)
[SETQ POS (FETCH TXDTMSG OF (SETQ REC
(FETCH TXDTTOP
OF ADDR]
(/REPLACE TXDTMSG OF REC WITH MSG)
(RETURN POS)))
(TXDTSETQQ REC POS ADDR)
(RETURN (EDITPUTMSG REC POS MSG])
(TXDTREAD
[LAMBDA (FILE ADDR BEHIND COUNTLCFLG)
(* inserts the file FILE immediately following ADDR and returns the addr of
the begining or end of the insertion depending on BEHIND.
Counts the lines/chars if COUNTLCFLG is on, just as TXDTINSERT does)
(TXDTINSERT (LIST TXDTINSERTFILEKEY FILE)
ADDR BEHIND COUNTLCFLG])
(TXDTRESETFORMFN
[LAMBDA NIL
(COND
(TXDTRESETFORMBREAKLOCKSFLG (TXDTBREAKLOCKS)
(SETQ TXDTRESETFORMBREAKLOCKSFLG NIL])
(TXDTSUBST
[LAMBDA (NEWSTR OLDSTR ADDR1 ADDR2 BACKWARDS MAXSUBSTS COUNTLCFLG
OLDBOX)
(* replaces OLDSTR by NEWSTR MAXSUBSTS times in the given window.
ADDR1 defaults to top. ADDR2 defaults to btm. MAXSUBSTS defaults to
infinity. Returns the address following the last subst.
Note that if none were made, this will be ADDR1. Sets the global
TXDTSUBSTCNT to the number of subst actually made.)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(COND
((AND ADDR1 ADDR2 (NEQ ADDR1 0)
(NEQ ADDR1 1)
(NEQ ADDR1 (QUOTE TOP))
(NEQ ADDR2 (QUOTE BTM))
(EDITGREATERP REC1 POS1 REC2 POS2))
(* if user specified both addrs, check that they define a window.
We don't check it if either defaulted, since the defaults insure that the
EDITLESSEQP would succeed. It could be that he gave us one address which
was actually bad, but theoretically that will be caught by the unbox
above.)
(ERROR "ILL-DEFINED WINDOW" (LIST ADDR1 ADDR2))
(ERROR!)))
(OR (STRINGP OLDSTR)
(SETQ OLDSTR (MKSTRING OLDSTR)))
(SETQ TXDTSUBSTCNT (EDITSUBST NEWSTR OLDSTR REC1 POS1 REC2
POS2 BACKWARDS (COND
((FIXP MAXSUBSTS)
MAXSUBSTS)
(T -1))
COUNTLCFLG))
(RETURN (COND
(BACKWARDS (TXDTBOXRECPOS EDITINSERTREC1
EDITINSERTPOS1 OLDBOX))
(T (TXDTBOXRECPOS EDITINSERTREC2 EDITINSERTPOS2
OLDBOX])
(TXDTSUBSTJFNS
[LAMBDA (ALIST BUFLST)
(PROG (BLST TEMPREC)
(* Since we might hit the same rec more than once we don't want to be
fooled into substituting a new for an old and then undoing it with a later
subst. Thus we use a hash array to keep track of all ecs seen.
Make sure the array exists and is clean.)
[COND
((ARRAYP (OR (AND (LISTP SMASHEDRECHASHARRAY)
(CAR SMASHEDRECHASHARRAY))
SMASHEDRECHASHARRAY))
(CLRHASH SMASHEDRECHASHARRAY))
(T (SETQ SMASHEDRECHASHARRAY (CONS (HARRAY 512)
1.5]
(* Remove noops from alist and quit if
we have nothing to do.)
[SETQ ALIST (for PAIR in ALIST collect PAIR
unless (EQ (CAR PAIR)
(CDR PAIR]
(COND
((NULL ALIST)
(RETURN BUFLST))) (* get the list of buffers implied by
the arg.)
(SETQ BLST (COND
((type? TXDTBUFFER BUFLST)
(RPLACA (QUOTE (FOO))
BUFLST))
((LISTP BUFLST)
BUFLST)
(BUFLST (ERROR "UNRECOGNIZED BUFFER LIST" BUFLST))
(T TXDTCURBUFLST))) (* Do the work!)
[for BUFFER in BLST do (SETQ TEMPREC
(fetch TXDTNEXT
of (fetch TXDTTOP of BUFFER)))
(until (BTMRECP TEMPREC)
do (SMASHJFN ALIST TEMPREC)
(SETQ TEMPREC
(fetch TXDTNEXT of TEMPREC]
(RETURN BUFLST])
(TXDTUNBOX
[LAMBDA (ADDR CHARFLG BOUNDARYERRFLG OLDPAIR)
(PROG (REC POS DOTREC DOTPOS CLOSEADDR FIRSTREC SCRATCHNO)
(OR (LISTP OLDPAIR)
(SETQ OLDPAIR (CONS NIL NIL)))
[COND
((NUMBERP (CAR OLDPAIR))
(SETQ SCRATCHNO (CAR OLDPAIR]
(TXDTSETQQ REC POS ADDR (AND BOUNDARYERRFLG (QUOTE BOUNDARYERR)))
(COND
[(OR (NULL TXDTPOETFLG)
CHARFLG)
(SETQ FIRSTREC (fetch TXDTNEXT of (GETTOPREC REC)))
(EDITCOUNTLC FIRSTREC (fetch TXDTOFFSET1 of FIRSTREC)
REC POS (EQ CHARFLG (QUOTE CHARS))
SCRATCHNO)
(RETURN (COND
[CHARFLG (RPLNODE OLDPAIR NIL (SETN SCRATCHNO (ADD1 EDITCOUNTC]
(T (RPLNODE OLDPAIR (SETN SCRATCHNO (ADD1 EDITCOUNTL))
(ADD1 EDITCOUNTC]
(T (TXDTSETQQ DOTREC DOTPOS TXDTPOETDOTADDR)
(COND
[(NLISTP (GETATOMVAL (QUOTE EDITCLOSESTLST)))
(SETQ EDITCLOSESTLST (LIST (CONS DOTREC (CONS DOTPOS TXDTPOETDOT]
(T (FRPLACA (CAR EDITCLOSESTLST)
DOTREC)
(FRPLACA (CDAR EDITCLOSESTLST)
DOTPOS)
(FRPLACD (CDAR EDITCLOSESTLST)
TXDTPOETDOT)))
(SETQ CLOSEADDR (EDITCLOSEST REC POS EDITCLOSESTLST))
(* Now CLOSEADDR is either TOP or BTM or TXDTPOETDOT,
whichever is closest to ADDR.
Next we do the appropriate countlc.)
(RETURN (COND
((EQ CLOSEADDR (QUOTE TOP))
(COND
((NEQ EDITCLOSESTREC TOPREC)
(ERROR "TXDT ADDRESS NOT IN CURRENT BUFFER" ADDR)))
(EDITCOUNTLC (fetch TXDTNEXT of TOPREC)
(fetch TXDTOFFSET1 of (fetch TXDTNEXT of TOPREC))
REC POS NIL SCRATCHNO)
(RPLNODE OLDPAIR (SETN SCRATCHNO (ADD1 EDITCOUNTL))
(ADD1 EDITCOUNTC)))
((EQ CLOSEADDR (QUOTE BTM))
(COND
((NEQ EDITCLOSESTREC BTMREC)
(ERROR "TXDT ADDRESS NOT IN CURRENT BUFFER" ADDR)))
(EDITCOUNTLC REC POS BTMREC 0 NIL SCRATCHNO)
(SETN SCRATCHNO (IPLUS 1 TXDT$ (IMINUS EDITCOUNTL)))
(EDITMOVE 0 NIL REC POS)
(EDITCOUNTLC EDITMOVECREC EDITMOVECPOS REC POS T)
(RPLNODE OLDPAIR SCRATCHNO (ADD1 EDITCOUNTC)))
[TXDTCLOSESTFORWFLG (EDITCOUNTLC REC POS DOTREC DOTPOS NIL SCRATCHNO)
(COND
((IEQP EDITCOUNTL 0)
(RPLNODE OLDPAIR (SETN SCRATCHNO (CAR TXDTPOETDOT))
(IDIFFERENCE (OR (CDR TXDTPOETDOT)
1)
EDITCOUNTC)))
(T (SETN SCRATCHNO (IDIFFERENCE (CAR TXDTPOETDOT)
EDITCOUNTL))
(EDITMOVE 0 NIL REC POS)
(EDITCOUNTLC EDITMOVECREC EDITMOVECPOS REC POS T)
(RPLNODE OLDPAIR SCRATCHNO (ADD1 EDITCOUNTC]
(T (EDITCOUNTLC DOTREC DOTPOS REC POS NIL SCRATCHNO)
(* We do this test out here to determine what should be in the 3rd arg of the RPLNODE just because if we put the
test in the 3rd arg the destructive SETN of SCRATCHNO -- which is also possibly EDITCOUNTL! -- will screw us.
Indeed, HAS screwed us!)
(COND
((IEQP EDITCOUNTL 0)
(RPLNODE OLDPAIR (SETN SCRATCHNO (IPLUS (CAR TXDTPOETDOT)
EDITCOUNTL))
(IPLUS (OR (CDR TXDTPOETDOT)
1)
EDITCOUNTC)))
(T (RPLNODE OLDPAIR (SETN SCRATCHNO (IPLUS (CAR TXDTPOETDOT)
EDITCOUNTL))
(ADD1 EDITCOUNTC])
(TXDTUNBOXRECPOS
[LAMBDA (ADDR BOUNDARYERRFLG)
(* This function unboxes ADDR and returns the rec component, after setting
the global TXDTUNBOXPOS to the pos component. If ADDR is a number it is
taken to mean the record and position of that line in the current buffer --
counted from top or btm depending on sign. If it is a pair of numbers it is
taken to be a line and character position. If it is the atom TOP or BTM the
obvious is used. If it is an array of length 2 it is assumed to be a record
and position and it is just unpacked. However, it is possible that the pos
component is no longer consistent with the rec component.
This can happen if the record has been split since the two were boxed up
and given to the outside world. The action in this case is to scan the
whole buffer from top to btm looking for a record with TEXT EQ to the
current rec, and offsets which include the current pos.
If not found, an error is caused.)
(PROG (REC POS DOTLINE DOTCHAR)
[SETQ TXDTUNBOXPOS
(COND
((TXDTADDRP ADDR) (* its a rec,pos pair)
(SETQ REC (TXDTVERIFYADDR ADDR))
(COND
((AND BOUNDARYERRFLG (BTMRECP REC))
(ERROR!)))
TXDTVERIFYPOS)
([OR (AND (FIXP ADDR)
(SETQ POS 1))
(AND (LISTP ADDR)
(FIXP (SETQ POS (OR (CDR ADDR)
1)))
(OR (FIXP (CAR ADDR))
(NULL (CAR ADDR)))
(PROG1 T (SETQ ADDR (CAR ADDR]
(* it is either a number, or a dotted pair with a number in the CDR and
either a number or NIL in the CAR. If so, then because of the SETQs in the
test, ADDR is now the line number we are to move to, and POS is the char
no.)
(COND
(TXDTPOETFLG
(* If this flg is set the we assume TXDTPOETDOT is a pair of form
(lineno . charno), that TXDTPOETDOTADDR is a valid TXDT boxed address of
that same location, and that TXDT$ is the number of lines in the buffer.
We will move to the line no ADDR char no POS in the shortest possible
move.)
(SETQ DOTLINE (CAR TXDTPOETDOT))
(SETQ DOTCHAR (OR (CDR TXDTPOETDOT)
1))
(COND
((AND (EQ ADDR DOTLINE)
(EQ POS DOTCHAR))
(* Convention is that TXDTPOETDOT is always a dotted pair address, and
TXDTPOETDOTADDR is always conistent with it, i.e. the txdt bbxed address
for TXDTPOETDOT)
(SETQ REC (TXDTVERIFYADDR
TXDTPOETDOTADDR))
(COND
((AND BOUNDARYERRFLG
(EQ REC BTMREC))
(ERROR!)))
TXDTVERIFYPOS)
((IGREATERP ADDR (ADD1 TXDT$))
(* just in case we are given a funny addr. Note that a line no might be
TXDT$+1, if the last line doesn't have a cr on it.)
(COND
(BOUNDARYERRFLG (ERROR!)))
(SETQ REC BTMREC)
0)
((ILESSP ADDR DOTLINE)
(* if ADDR is between TOP and TXDTPOETDOTADDR decide which of the two is
closest)
(COND
((ILESSP ADDR (IDIFFERENCE DOTLINE
ADDR))
(* if closest to TOP, just goto)
(EDITGOTO ADDR POS
BOUNDARYERRFLG)
(SETQ REC EDITGOTOREC)
EDITGOTOPOS)
(T
(* otherwise, closest to
TXDTPOETDOTADDR, so move from there
backwards)
(EDITMOVE (IDIFFERENCE ADDR
DOTLINE)
(SUB1 POS)
(TXDTVERIFYADDR
TXDTPOETDOTADDR)
TXDTVERIFYPOS
BOUNDARYERRFLG)
(SETQ REC EDITMOVECREC)
EDITMOVECPOS)))
((ILESSP (IDIFFERENCE ADDR DOTLINE)
(IDIFFERENCE TXDT$ ADDR))
(* if address is between TXDTPOETDOTADDR and TXDT$, see if its closest to
TXDTPOETDOTADDR)
(EDITMOVE (IDIFFERENCE ADDR DOTLINE)
(SUB1 POS)
(TXDTVERIFYADDR
TXDTPOETDOTADDR)
TXDTVERIFYPOS
BOUNDARYERRFLG)
(SETQ REC EDITMOVECREC)
EDITMOVECPOS)
((IGREATERP ADDR TXDT$)
(* If this is so, ADDR must be TXDT$+1.)
(EDITMOVE 0 (SUB1 POS)
BTMREC 0 BOUNDARYERRFLG)
(SETQ REC EDITMOVECREC)
EDITMOVECPOS)
(T (* otherwise, its closest to BTM)
(EDITMOVE (IPLUS ADDR (IMINUS
TXDT$)
-1)
(SUB1 POS)
BTMREC 0 BOUNDARYERRFLG)
(SETQ REC EDITMOVECREC)
EDITMOVECPOS)))
(T (EDITGOTO ADDR POS BOUNDARYERRFLG)
(* use EDITGOTO to move to the right line and char position and then set
our locals to the result)
(SETQ REC EDITGOTOREC)
EDITGOTOPOS)))
((EQ ADDR (QUOTE TOP))
(SETQ REC (fetch TXDTNEXT of TOPREC))
(fetch TXDTOFFSET1 of REC))
((EQ ADDR (QUOTE BTM))
(COND
(BOUNDARYERRFLG (ERROR!)))
(SETQ REC BTMREC)
0)
(T (* address not recognized)
(ERROR "TXDT ADDRESS NOT RECOGNIZED" ADDR)
(ERROR!]
(RETURN REC])
(TXDTUNPMAP
[LAMBDA NIL
(SWAPOUT TXDTPAGE1)
(SWAPOUT TXDTPAGE2])
(TXDTVALIDP
[LAMBDA (X BOUNDARYERRFLG)
|
(* returns T if X is a valid address -- that is, one that does not cause an error when used -- and NIL otherwise.)
|
|
(AND (XNLSETQ|(TXDTUNBOXRECPOS X (AND BOUNDARYERRFLG (QUOTE BOUNDARYERR)))
NOBREAK) |
T])
(TXDTVERIFYADDR
[LAMBDA (ADDR)
(* Assuming ADDR is a boxed addr, be sure the components are still valid. If not, cause an error.
If so, set TXDTVERIFYPOS to the pos and return the rec. NOTE: the rec,pos returned may not be same as those in the
box, since the boxed ones might be out of date. In this case, this fn searches the TXDTSPLITREC list in the REC in
the ADDR, attempting to find one which still connains the text indicated.)
(PROG (REC SPECIALBTMFLG)
(SETQ REC (fetch TXDTREC of ADDR))
[COND
((AND (LISTP REC)
(EQ (CAR REC)
(QUOTE SPECIAL-BTM-MARK)))
(* If the rec is actually a list, it is of the form (SPECIAL-BTM-MARK rec . pos), where rec,pos addresses the char
immediately before the one we really want to be addressing.)
(SETQ TXDTVERIFYPOS (CDDR REC))
(SETQ REC (CADR REC))
(SETQ SPECIALBTMFLG T))
(T (SETQ TXDTVERIFYPOS (fetch TXDTPOS of ADDR]
CHK (COND
((BTMRECP REC) (* if we are at btm, make sure TXDTVERIFYPOS is 0)
(SETQ TXDTVERIFYPOS 0)
(RETURN REC))
[(ILESSP (fetch TXDTOFFSET2 of REC)
-1500)
(* if the rec has been deleted, see if the char at pos was included at the time of deletion.
If so, cause an error, otherwise search for a rec containg this text and pos.)
(COND
([AND (NOT (IGREATERP (fetch TXDTOFFSET1 of REC)
TXDTVERIFYPOS))
(ILESSP TXDTVERIFYPOS (IPLUS 2561 (fetch TXDTOFFSET2 of REC]
(ERROR "TXDT ADDRESS NOT IN CURRENT BUFFER" ADDR)
(ERROR!))
(T (GO FINDSPLITREC]
((OR (ILESSP TXDTVERIFYPOS (fetch TXDTOFFSET1 of REC))
(NOT (IGREATERP (fetch TXDTOFFSET2 of REC)
TXDTVERIFYPOS))) (* if TXDTVERIFYPOS falls outside the range of the rec,
initiate search)
(GO FINDSPLITREC))
(SPECIALBTMFLG (* If address is valid, then we must simply move it
forward by 1)
(EDITMOVEC 1 REC TXDTVERIFYPOS)
(SETQ TXDTVERIFYPOS EDITMOVECPOS)
(COND
((NOT (BTMRECP EDITMOVECREC))
(* if the actual addr indicated is not the btm, then get
rid of the special mark.)
(/replace TXDTPOS of ADDR with TXDTVERIFYPOS)
(/replace TXDTREC of ADDR with EDITMOVECREC)))
(RETURN EDITMOVECREC))
(T (RETURN REC)))
FINDSPLITREC
(SETQ REC (EDITFINDSPLITREC REC TXDTVERIFYPOS))
(COND
(REC | (* We know that EDITFINDSPLITREC will return a legal
addr, but we will go back and check just so we hit the
SPECIALBTMFLG case.)
(GO CHK)) |
(T (ERROR "TXDT ADDRESS INTO DELETED AREA" ADDR])
(TXDTWHEREIS
[LAMBDA (ADDR)
(PROG (REC POS)
(TXDTSETQQ REC POS ADDR)
LOOP(COND
[(TOPRECP REC)
(RETURN (for BUF in TXDTCURBUFLST
thereis (EQ REC (fetch TXDTTOP of BUF]
(T (SETQ REC (fetch TXDTPREV of REC))
(GO LOOP])
(TXDTWRITE
[LAMBDA (FILE ADDR1 ADDR2)
(* writes the window to the file. Default addresses are top to btm.
Returns full file name.)
(PROG (REC1 POS1 REC2 POS2)
(TXDTSETQQ REC1 POS1 (OR ADDR1 (QUOTE TOP)))
(TXDTSETQQ REC2 POS2 (OR ADDR2 (QUOTE BTM)))
(RETURN (EDITWRITE FILE REC1 POS1 REC2 POS2])
(UNLOCK
[LAMBDA (REC)
(* Unlocks the page containing TEXT of REC, if one exists and it is locked)
(SETN EDITUNLOCKSOURCEBOX (fetch TXDTSOURCE of REC))
(COND
[(IEQP EDITUNLOCKSOURCEBOX TXDTPAGE1CONTENTS)
(COND
((NOT (IEQP TXDTPAGE1LOCK 0))
(SETN TXDTPAGE1LOCK (SUB1 TXDTPAGE1LOCK]
((IEQP EDITUNLOCKSOURCEBOX TXDTPAGE2CONTENTS)
(COND
((NOT (IEQP TXDTPAGE2LOCK 0))
(SETN TXDTPAGE2LOCK (SUB1 TXDTPAGE2LOCK])
(UNMARK
[LAMBDA (CHAIN)
(* Assuming CHAIN is MARKEDP unmarks every rec in it by setting its
TXDTOFFSET2 to TXDTOFFSET2+2561.)
(PROG NIL
LOOP(COND
((NOT (type? TXDTRECORD CHAIN))
(RETURN T)))
(/replace TXDTOFFSET2 of CHAIN
with (IPLUS 2561 (fetch TXDTOFFSET2 of CHAIN)))
(SETQ CHAIN (fetch TXDTNEXT of CHAIN))
(GO LOOP])
)
(RPAQQ TXDTINSERTFILEKEY "TXDTINSERTFILEKEY")
(RPAQQ TXDTINSERTMSGKEY "TXDTINSERTMSGKEY")
(RPAQ STRINGPOINTERTEMP (MKSTRING))
(RPAQ TXDTSCRATCHSTRING (CONCAT
"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXX"))
(RPAQ NCHARSTXDTSCRATCHSTRING (NCHARS TXDTSCRATCHSTRING))
(RPAQ EDITREADFILELST NIL)
(RPAQQ TXDTPTRCHAR ^)
(RPAQ TXDTPMAPCNT 0)
(RPAQ TXDTSWAPCNT 0)
(RPAQ TXDTRECORDCNT 0)
(RPAQ TXDTBUFFERCNT 0)
(RPAQ TXDTADDRCNT 0)
(RPAQ TXDTGRABBEDOBJCNT 0)
(RPAQ TXDTEXTENSION NIL)
(RPAQ TXDTPOETFLG NIL)
(RPAQ TXDTEOLPNOTINTERRUPTED NIL)
(RPAQ TXDTRESETFORMBREAKLOCKSFLG NIL)
(RPAQ TXDTCURBUFLST NIL)
(RPAQ TXDTCHARACTER0 (CHARACTER 0))
(RPAQ TXDTTEMPSOURCEBOX 0)
(RPAQ TXDTSCRATCHFILE T)
(RPAQ TXDTESCAPECHAR NIL)
(RPAQ TXDTPRINTUSERFNBOX NIL)
(RPAQQ HIDDENFNS (TXDTGETMSG TXDTGETMSGLST TXDTMAPMSG TXDTPUTMSG
TXDTPRINTUSERFN RTXDT))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(DATATYPE TXDTRECORD ((TXDTSOURCE FIXP)
TXDTOFFSET1 TXDTOFFSET2 TXDTNEXT TXDTPREV
TXDTSPLITRECS TXDTMSG))
(DATATYPE TXDTADDR (TXDTREC (TXDTPOS INTEGER)))
(DATATYPE TXDTGRABBEDOBJ (TXDTCHAIN TXDTGRABFLG))
(DATATYPE TXDTBUFFER (TXDTTOP TXDTBTM TXDTPOETDOT TXDTPOETDOTADDR TXDT$)
)
)
(/DECLAREDATATYPE (QUOTE TXDTRECORD)
(QUOTE (FIXP POINTER POINTER POINTER POINTER POINTER
POINTER)))
(/DECLAREDATATYPE (QUOTE TXDTADDR)
(QUOTE (POINTER FIXP)))
(/DECLAREDATATYPE (QUOTE TXDTGRABBEDOBJ)
(QUOTE (POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE TXDTBUFFER)
(QUOTE (POINTER POINTER POINTER POINTER POINTER)))
(PUTPROPS DCLCONSTS AMAC (LAMBDA (L)
(MAPC L (FUNCTION (LAMBDA
(P)
(SET (CAR P)
(CADR P)))))
NIL))
(PUTPROPS CALCOFFSET AMAC (NIL (* calc the number of bytes between the
one pointed to by the pb in AC1 and
that by AC2, minus 1; See the
function CALCOFFSET for a more
complete comment. NOTE: this function
uses AC1 - AC6!)
(HLRZ 3 , 1)
(HLLI 1 , 0)
(HLRZ 5 , 2)
(HLLI 2 , 0)
(ADDI 1 , 1)
(SUB 2 , 1)
(IMULI 2 , 5)
(IDIVI 3 , 28672)
(ADD 2 , 3)
(IDIVI 5 , 28672)
(SUBI 5 , 4)
(SUB 2 , 5)
(MOVE 1 , 2)))
(PUTPROPS NREFE AMAC (NLAMBDA (FORM TEMP)
(SETQ TEMP (LAST (SETQ FORM (COPY FORM))))
(RPLACA TEMP (EVAL (CAR TEMP)))
(LIST (LIST (QUOTE NREF)
FORM))))
(PUTPROPS PACKJFNPG MACRO ((JFN PGNO) (* packs a JFN and file PGNO)
(SETN EDITPACKJFNPGBOX (LOGOR (LLSH JFN 18)
PGNO))))
(PUTPROPS BYTEPOINTER MACRO ((BASE OFFSET)
(* Constructs a PDP-10 byte pointer so that an ILDB or IDPB
will fetch the OFFSETth byte from BASE.
NOTE: This function takes pains to generate PROPER byte
pointers -- ie., decrements the word addr and starts at bit
offset 1 when it could just slam 44 into the bit offset.
This is so that byte offsets generated by this function may be
used to define the terminating bps for sequential fetching of
bytes, since ILDB always produces a proper byte pointer as the
result of its increment.)
(LOC (ASSEMBLE NIL
(CQ BASE)
(PUSHN 1)
(CQ (VAG OFFSET))
(IDIVI 1 , 5)
(JUMPN 2 , * 4)
(* offset non-zero, so skip next 3 instr.
This obscure code is used rather than a label so that this
thing can be a macro.)
(NREF (SOS 0))
(* decrmt base by 1 -- can't decrmt AC1 for fear that its 0
right now.)
(HRLI 1 , 10700Q)
(* slam in bit offset and size
fields)
(JUMPA * 3) (* and go add BASE addr in)
(IMUL 2 , = -70000Q)
(* non-zero offset, shift up to high 6, turn into bit count,
and negate)
(HRLI 1 , 440700Q (2))
(POPN 2) (* add BASE addr to AC1)
(ADD 1 , 2)))))
(PUTPROPS STRINGBASE MACRO ((STR)
(* unpacks the base address of the strig STR and returns it.
Also sets the globals OFFSET1 and OFFSET2 to the start and end
offsets for the string.)
(SETN OFFSET2 (LOC (ASSEMBLE NIL
(CQ STR)
(MOVE 1 , 0 (1))
(* get string pointer of STR in
AC1)
(MOVE 2 , 1)
(* copy it into AC2)
(AND 2 , = 7777777Q)
(* get the low 25Q bits --
that's the byte addr)
(IDIVI 2 , 5)
(* div by 5.0 now 2 has the word addr and 3 has the init
offset)
(LSH 1 , 777753Q)
(* shift AC1 down 25Q so it now
has NCHARS in it)
(ADD 1 , 3)
(* add init offset to length to
get OFFSET2)
(PUSHN 2)
(PUSHN 3)
(* save 2 an 3 from upcoming
LISP)
)))
(SETN OFFSET1 (LOC (ASSEMBLE NIL
(POPN 1))))
(ASSEMBLE NIL (* return base address)
(POPN 1))))
(PUTPROPS TXDTSETQQ MACRO (X (LIST (QUOTE PROGN)
(LIST (QUOTE SETQ)
(CAR X)
(CONS (QUOTE TXDTUNBOXRECPOS)
(CDDR X)))
(LIST (QUOTE SETQ)
(CADR X)
(QUOTE TXDTUNBOXPOS)))))
(PUTPROPS JRST MACRO ((X)
(ASSEMBLE NIL
(J (QUOTE X)))))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: TXDT BTMRECP TOPRECP GETBTMREC GETTOPREC MARKEDP CALCOFFSET
COUNTEOLS EDITCHAR EDITCHAR1 EDITCHAR2 EDITUNSPLITCRLF
EDITCHAR3 EDITCLOSEALL EDITCLOSEF EDITCLOSEST EDITCOPYGRABBED
EDITCOUNTLC EDITDELETE EDITGOTO EDITGRAB EDITGREATERP
EDITINSERT EDITMKSTRING EDITMOVE EDITMOVEC EDITMOVEL EDITPRINT
EDITSEARCH EDITSUBST EDITWRITE LOADREC PMAP PRINTSEG SWAPIN
SWAPOUT TXDTADDRP TXDTANCHOREDFIND TXDTBOX TXDTBOXRECPOS
TXDTBREAKLOCKS TXDTCHAR TXDTCLOSEALL TXDTCLOSEF TXDTCLOSEST
TXDTCOPY TXDTCOUNTLC TXDTDELETE TXDTEQUAL TXDTFIND TXDTGOTO
TXDTGRAB TXDTGRABBEDP TXDTGREATERP TXDTINSERT TXDTMKSTRING
TXDTMOVE TXDTPRINT TXDTREAD TXDTSUBST TXDTUNBOX TXDTUNBOXRECPOS
TXDTVALIDP TXDTWRITE UNLOCK UNMARK TXDTVERIFYADDR TXDTEOLP
TXDTFREESPACE EDITRESETSAVEFN TXDTCONTIGP TXDTCONTIGIFY
TXDTEMPTYP TXDTCURBUF EDITCONTIGP TXDTKILLBUF TXDTRESETFORMFN
REOPENFILE SMASHJFN EDITPUTMSG TXDTPUTMSG TXDTGETMSG
TXDTGETMSGLST TXDTMAPMSG EDITINSERTESCAPE TXDTFILEPOSITION
TXDTUNPMAP TXDTSUBSTJFNS TXDTGETNEWJFN TXDTWHEREIS
EDITFINDSPLITREC EDITMAPCHARS TXDTMAPCHARS TXDTCOUNTPIECES
TXDTINIT TXDTPIECE TXDTNEXTPIECE TXDTPREVPIECE
(ENTRIES TXDTADDRP TXDTBOX TXDTBREAKLOCKS TXDTCHAR TXDTCLOSEALL
TXDTCLOSEF TXDTCLOSEST TXDTCOPY TXDTCOUNTLC TXDTDELETE
TXDTEQUAL TXDTFIND TXDTGOTO TXDTGRAB TXDTGRABBEDP
TXDTGREATERP TXDTINSERT TXDTMKSTRING TXDTMOVE
TXDTPRINT TXDTREAD TXDTSUBST TXDTUNBOX TXDTVALIDP
TXDTWRITE TXDTEOLP TXDTFREESPACE EDITRESETSAVEFN
TXDTCONTIGP TXDTCONTIGIFY TXDTEMPTYP TXDTCURBUF
TXDTKILLBUF TXDTRESETFORMFN TXDTPUTMSG TXDTGETMSG
TXDTGETMSGLST TXDTMAPMSG TXDTFILEPOSITION TXDTUNPMAP
TXDTSUBSTJFNS TXDTGETNEWJFN TXDTWHEREIS TXDTMAPCHARS
TXDTCOUNTPIECES TXDTINIT TXDTPIECE TXDTNEXTPIECE
TXDTPREVPIECE)
(NOLINKFNS TXDTPRINTUSERFN TXDTGETNEWJFN)
(BLKLIBRARY MEMB EQUAL ASSOC)
(LOCALFREEVARS TXDTPOETFLG)
(GLOBALVARS BASEADDR BTMREC EDITCHARCODE EDITCHARPOS
EDITCHARREC EDITCOUNTC EDITCOUNTL EDITDELETEPOS
EDITDELETEREC EDITGOTOPOS EDITGOTOREC
EDITINSERTPOS1 EDITINSERTPOS2 EDITINSERTREC1
EDITINSERTREC2 EDITMOVECPOS EDITMOVECREC
EDITMOVELPOS EDITMOVELREC EDITREADFILELST
EDITSEARCHPOS1 EDITSEARCHPOS2 EDITSEARCHREC1
EDITSEARCHREC2 FINDFIRSTMODE FINDNCHARSNLEFT
FINDNCHARSOFF NCHARSTXDTSCRATCHSTRING OFFSET1
OFFSET2 TXDTPAGE1 TXDTPAGE1CNT TXDTPAGE1CONTENTS
TXDTPAGE1LOCK TXDTPAGE2 TXDTPAGE2CNT
TXDTPAGE2CONTENTS TXDTPAGE2LOCK TXDTSWAPCNT
TXDTSCRATCHSTRING TOPREC TXDTDELTA TXDTEXTENSION
TXDTGRABADDR TXDTPMAPCNT TXDTPTRCHAR TXDTSUBSTCNT
TXDTSWAPCNT TXDTUNBOXPOS TXDTPOETFLG TXDTPOETDOT
TXDTPOETDOTADDR TXDT$ TXDTCLOSESTFORWFLG
TXDTVERIFYPOS TXDTEOLPTEXT TXDTEOLPNOTINTERRUPTED
TXDTEOLPOFFSET2 TXDTEOLPANS TXDTFINDCNT
EDITCLOSESTLST TXDTRESETFORMBREAKLOCKSFLG
TXDTSCRATCHFILE TXDTCURBUFLST TXDTCURBUF
TXDTRECORDCNT TXDTADDRCNT TXDTBUFFERCNT
TXDTGRABBEDOBJCNT EDITPAGEINFO TXDTINSERTFILEKEY
TXDTESCAPECHAR TXDTPRINTPTRBOX
TXDTINSERTFILEPOS1BOX TXDTINSERTFILEPOS2BOX
TXDTINSERTPOS1BOX TXDTINSERTPOS2BOX
LOADRECSOURCEBOX EDITUNLOCKSOURCEBOX
EDITPACKJFNPGBOX TXDTPRINTUSERFNBOX
SMASHEDRECHASHARRAY EDITCLOSESTREC TXDTMAXMSGLEN
EDITCOUNTSTOPREC EDITCOUNTSTOPPOS TXDTMSGBUFFER
TXDTCHARACTER0 TXDTTEMPSOURCEBOX))
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (6643 188203 (BTMRECP 6655 . 6722) (CALCOFFSET 6726 . 7454
) (COUNTEOLS 7458 . 8097) (EDITCHAR 8101 . 10371) (EDITCHAR1 10375 .
10609) (EDITCHAR2 10613 . 11624) (EDITCHAR3 11628 . 12579) (EDITCLOSEALL
12583 . 12838) (EDITCLOSEF 12842 . 13507) (EDITCLOSEST 13511 . 16976) (
EDITCONTIGP 16980 . 19157) (EDITCOPYGRABBED 19161 . 20573) (EDITCOUNTLC
20577 . 30729) (EDITDELETE 30733 . 36547) (EDITFINDSPLITREC 36551 .
37155) (EDITGOTO 37159 . 38249) (EDITGRAB 38253 . 41248) (EDITGREATERP
41252 . 42055) (EDITINSERT 42059 . 54665) (EDITINSERTESCAPE 54669 .
59489) (EDITMAPCHARS 59493 . 64316) (EDITMKSTRING 64320 . 77419) (
EDITMOVE 77423 . 79408) (EDITMOVEC 79412 . 83916) (EDITMOVEL 83920 .
85775) (EDITPRINT 85779 . 89747) (EDITPUTMSG 89751 . 90436) (
EDITRESETSAVEFN 90440 . 90518) (EDITSEARCH 90522 . 107556) (EDITSUBST
107560 . 112103) (EDITUNSPLITCRLF 112107 . 113297) (EDITWRITE 113301 .
124200) (GETBTMREC 124204 . 124475) (GETTOPREC 124479 . 124768) (LOADREC
124772 . 125534) (MARKEDP 125538 . 125966) (PMAP 125970 . 127268) (
PRINTSEG 127272 . 129288) (REOPENFILE 129292 . 129773) (RTXDT 129777 .
131517) (SMASHJFN 131521 . 132711) (SWAPIN 132715 . 134215) (SWAPOUT
134219 . 134668) (TOPRECP 134672 . 134739) (TXDTADDRP 134743 . 134808) (
TXDTANCHOREDFIND 134812 . 136566) (TXDTBOX 136570 . 137213) (
TXDTBOXRECPOS 137217 . 137710) (TXDTBREAKLOCKS 137714 . 138240) (
TXDTCHAR 138244 . 141888) (TXDTCLOSEALL 141892 . 142019) (TXDTCLOSEF
142023 . 142186) (TXDTCLOSEST 142190 . 142543) (TXDTCONTIGIFY 142547 .
143924) (TXDTCONTIGP 143928 . 144855) (TXDTCOPY 144859 . 146039) (
TXDTCOUNTLC 146043 . 147004) (TXDTCOUNTPIECES 147008 . 147516) (
TXDTCURBUF 147520 . 150257) (TXDTDELETE 150261 . 151058) (TXDTEMPTYP
151062 . 151312) (TXDTEOLP 151316 . 152193) (TXDTEQUAL 152197 . 152467)
(TXDTFILEPOSITION 152471 . 153103) (TXDTFIND 153107 . 154500) (
TXDTFREESPACE 154504 . 154850) (TXDTGETMSG 154854 . 155155) (
TXDTGETMSGLST 155159 . 156229) (TXDTGETNEWJFN 156233 . 156563) (TXDTGOTO
156567 . 156879) (TXDTGRAB 156883 . 158049) (TXDTGRABBEDP 158053 .
158116) (TXDTGREATERP 158120 . 158413) (TXDTINIT 158417 . 160286) (
TXDTINSERT 160290 . 161799) (TXDTKILLBUF 161803 . 163759) (TXDTMAPCHARS
163763 . 164722) (TXDTMAPMSG 164726 . 166154) (TXDTMKSTRING 166158 .
167053) (TXDTMOVE 167057 . 167715) (TXDTNEXTPIECE 167719 . 167992) (
TXDTPIECE 167996 . 168184) (TXDTPREVPIECE 168188 . 168633) (TXDTPRINT
168637 . 169968) (TXDTPRINTUSERFN 169972 . 170024) (TXDTPUTMSG 170028 .
170378) (TXDTREAD 170382 . 170755) (TXDTRESETFORMFN 170759 . 170907) (
TXDTSUBST 170911 . 172564) (TXDTSUBSTJFNS 172568 . 174063) (TXDTUNBOX
174067 . 177566) (TXDTUNBOXRECPOS 177570 . 182928) (TXDTUNPMAP 182932 .
183021) (TXDTVALIDP 183025 . 183444) (TXDTVERIFYADDR 183448 . 186628) (
TXDTWHEREIS 186632 . 186915) (TXDTWRITE 186919 . 187291) (UNLOCK 187295
. 187774) (UNMARK 187778 . 188200)))))
STOP