Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 7-Sep-80 23:32:18" <EMACS>INTER..89 41109
changes to: INTER.DIRECTORY
previous date: " 6-Sep-80 22:10:20" <EMACS>INTER..88)
(PRETTYCOMPRINT INTERCOMS)
(RPAQQ INTERCOMS ((* This is the LISP part of an interface between
EMACS and INTERLISP. The EMACS part is contained
in a :EJ file called INTER. The two main entries
are START.EMACS and DOWN. Documentation for the
interface exits.)
(FNS * INTERFNS)
(VARS * INTERVARS)
(P (PUTD (QUOTE SUBSYS0)
(VIRGINFN (QUOTE SUBSYS))))
(USERMACROS * INTERUSERMACROS)
(P (/NCONC AFTERSYSOUTFORMS (QUOTE ((FLUSH.EMACS)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
COMPILERVARS (ADDVARS (NLAMA PPTI)
(NLAML)
(LAMA)))))
[DECLARE: DONTEVAL@LOAD DONTCOPY
(* This is the LISP part of an interface between EMACS and INTERLISP.
The EMACS part is contained in a :EJ file called INTER. The two
main entries are START.EMACS and DOWN. Documentation for the
interface exits.) ]
(RPAQQ INTERFNS (,, BINARYMODE BYTEPOINTER CF CFNS CHECK.EMACS CP CREC
CV DISPLAY.IN.OTHER.WINDOW DOWN DOWN1 DUMP.LINES
DUMP.LINES? DUMPX DUMPX1 E! E. E.1
EDIT.DRIBBLE.FILE EMACS EMACS.?= EMACS.EOF.ERROR
EMACS.EVAL.CURRENT.SEXPR EMACS.FIND.SEXP
EMACS.GETDEF EMACS.P EMACS.PP EMACS.REPLACE.SEXP
EMACS.RETURN EMACS:.RETURN
ENABLE.CONTROL.C.CAPABILITY EMACS.EXE.FILE
FIND.SEXP FLUSH.EMACS GET.BYTE INTER.DIRECTORYNAME
MAKE.QUOTE MAP.BYTES MAP.BYTES1 MAP.PROCESS.TO.FILE
PAGE.OF.BYTE PAGEMODE PPTI PUTSTRING READ.AC
REFRESH SET.EMACS.VARS SETUP.FANCY.DRIBBLE
START.EMACS STIW SUBSYS1 SUBSYS2 WRITE.RSCAN))
(DEFINEQ
(,,
(LAMBDA (X Y)
(LOGOR (LLSH X 18)
Y)))
(BINARYMODE
(LAMBDA NIL
(JSYS 72 65 (LOGAND (LOGXOR (LLSH 1 6)
-1)
(JSYS 71 65 NIL NIL 2)))
(* We turn off B29 in the JFN Mode Word of the
current output device. If the user is in ASCII mode,
this puts him in Binary mode, which is what is
required by EMACS.)
NIL))
(BYTEPOINTER
(LAMBDA (BASE OFFSET)
(PLUS BASE
(,, (LOGOR (LLSH (ADD1 (ITIMES 7 (IDIFFERENCE 5
(IREMAINDER
OFFSET 5))))
12)
(LLSH 7 6))
(IQUOTIENT OFFSET 5)))))
(CF
(LAMBDA (NAME)
(CHECK.EMACS)
(* Gets the definition of a function and dives down
to EMACS. Like Teitelman's EDITF, CF uses LASTWORD
if given NIL. The unbroken, unadvised version of the
function is obtained. If the function is compiled,
we check first for an EXPR. Otherwise we try to get
it from the first file that contains it.)
(EMACS.GETDEF NAME)))
(CFNS
(LAMBDA (LST)
(for L in LST do (DUMPX (LIST (QUOTE DEFINEQ)
(LIST L (GETDEF L))))
(TERPRI EMACS.TEMP.FILE)
(TERPRI EMACS.TEMP.FILE))
(DOWN NIL)))
(CHECK.EMACS
(LAMBDA NIL
(OR LASTEMACS (START.EMACS))))
(CP
(LAMBDA (X)
(CHECK.EMACS)
(* Like EDITP, it dives down to EMACS with the
property list of a litatom to edit.)
(COND
((NULL X)
(SETQ X LASTWORD)
(PRINT LASTWORD T)))
(COND
((AND X (LITATOM X))
(PRIN3 "(SETPROPLIST " EMACS.TEMP.FILE)
(PRIN4 (KWOTE X)
EMACS.TEMP.FILE)
(SPACES 1 EMACS.TEMP.FILE)
(DUMPX (LIST (QUOTE QUOTE)
(GETPROPLIST X)))
(PRIN3 ")
" EMACS.TEMP.FILE)
(DOWN NIL))
(T (ERROR "No editable property list: " X)))))
(CREC
(LAMBDA (X) (* edited:
"10-May-79 16:27")
(* Like EDITRECF it dives down to EMACS with the
record definition of a litatom to edit.)
(COND
((NULL X)
(SETQ X LASTWORD)
(PRINT LASTWORD T)))
(COND
((AND X (RECLOOK X NIL NIL NIL NIL))
(DUMPX (RECLOOK X NIL NIL NIL NIL))
(DOWN NIL))
(T (ERROR "No editable type definition: " X)))))
(CV
(LAMBDA (X)
(CHECK.EMACS)
(* Like EDITV, it dives down to EMACS with the value
of a variable to edit.)
(COND
((NULL X)
(SETQ X LASTWORD)
(PRINT LASTWORD T)))
(COND
((NEQ (GETTOPVAL X)
(QUOTE NOBIND))
(PRIN3 (QUOTE %()
EMACS.TEMP.FILE)
(PRIN3 (QUOTE RPAQQ)
EMACS.TEMP.FILE)
(SPACES 1 EMACS.TEMP.FILE)
(PRIN4 X EMACS.TEMP.FILE)
(TERPRI EMACS.TEMP.FILE)
(SPACES 1 EMACS.TEMP.FILE)
(DUMPX (GETTOPVAL X))
(PRIN3 (QUOTE %))
EMACS.TEMP.FILE)
(TERPRI EMACS.TEMP.FILE)
(TERPRI EMACS.TEMP.FILE)
(DOWN NIL)
X)
(T (ERROR X (QUOTE NOBIND))))))
(DISPLAY.IN.OTHER.WINDOW
(LAMBDA (LIST)
(PRIN3 "M(M.M& Inter Display Text) " EMACS.TEMP.FILE)
(FOR X IN LIST DO (PRIN3 X EMACS.TEMP.FILE))
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1 T))
NIL NIL)))
(DOWN
(LAMBDA (NEGATE.ARG.FLG)
(CHECK.EMACS)
(RESETFORM (GCGAG NIL)
(DOWN1 NEGATE.ARG.FLG))))
(DOWN1
(LAMBDA (NEGATE.ARG.FLG)
(* This is the main function of the EMACS interface
for diving down to EMACS. Once START.EMACS has been
called, DOWN1 may be called at any time to enter
EMACS. FS EXIT will exit from EMACS and return to
DOWN1. When DOWN1 invokes EMACS, it passes to EMACS
a number whose absolute value is the current file
pointer of the file EMACS.TEMP.FILE.
The number is passed to TECO code in FSSUPERIOR,
which is invoked when EMACS starts running.
If the argument to DOWN1 is NIL, then the current
file pointer is passed, and EMACS simply inserts the
text at the end of the buffer.
If DOWN1 is given the argument T, then the negative
of the current file pointer is passed.
EMACS takes a negative number to be the instruction
to insert that much text, put it into q-register A,
delete the text and macro A.
Thus, if you simply want to insert some text into
the EMACS buffer, just print that text into
EMACS.TEMP.FILE and call (DOWN). But if you want a
fancier event to occur when EMACS starts to run,
then print TECO code to EMACS.TEMP.FILE and call
(DOWN T).)
(PROG (TEMP)
(SETQ TEMP (GETFILEPTR EMACS.TEMP.FILE))
(CLOSER EMACS.ARG.LOC (COND
(NEGATE.ARG.FLG (IMINUS TEMP))
(T TEMP)))
(* EMACS.ARG.LOC is a location in a page of LISP
that is identified with the spot that FSSUPERIOR
looks for its argument. See the last few pages of
<INFO>TECORD.)
(SETFILEPTR EMACS.TEMP.FILE 0)
(EVAL EMACS.ENTRY.HOOK)
(SETQ LASTEMACS (SUBSYS2 LASTEMACS NIL NIL (QUOTE START)
T))
(SET.EMACS.VARS)
(EVAL EMACS.EXIT.HOOK)
(RETURN (APPLY EMACS.RETURN.CASES NIL NIL)))))
(DUMP.LINES
(LAMBDA (N)
(PROG (END NUMBER.CHARS NUMBER.CRS I)
(COND
((OR (LISTP FANCY.DRIBBLE.FILE)
(NEQ (DRIBBLEFILE)
FANCY.DRIBBLE.FILE))
(RETURN NIL)))
(SETQ END (GETFILEPTR FANCY.DRIBBLE.FILE))
(SETQ NUMBER.CHARS (MIN (TIMES N 81)
END 2560))
(SETFILEPTR FANCY.DRIBBLE.FILE (DIFFERENCE END NUMBER.CHARS))
(JSYS 42 (OPNJFN FANCY.DRIBBLE.FILE)
(,, 147904 EMACS.AC.BLK.START)
NUMBER.CHARS)
(SETQ NUMBER.CRS 0)
(SETN I (SUB1 NUMBER.CHARS))
(until (OR (EQP NUMBER.CRS N)
(EQP I 0))
do (SETN I (SUB1 I))
(COND
((EQP (GET.BYTE I EMACS.AC.BLK.START)
13)
(SETQ NUMBER.CRS (ADD1 NUMBER.CRS)))))
(SETN I (PLUS I 2))
(JSYS 43 65
(,, (LOGOR (LLSH (ADD1 (ITIMES 7
(IDIFFERENCE
5
(IREMAINDER I 5))))
12)
(LLSH 7 6))
(PLUS EMACS.AC.BLK.START (IQUOTIENT I 5)))
(DIFFERENCE NUMBER.CHARS I))
(RETURN))))
(DUMP.LINES?
(LAMBDA NIL
(COND
((EQ NUMBER.OF.LINES 0)
NIL)
(T (DUMP.LINES NUMBER.OF.LINES)))))
(DUMPX
(LAMBDA (X)
(CHECK.EMACS)
(COND
((AND (LISTP X)
(EQ (CAR X)
(QUOTE DEFINEQ))
(LISTP (CDR X))
(NULL (CDDR X))
(LISTP (CADR X))
(LISTP (CDADR X))
(NULL (CDDADR X)))
(PRIN3 (QUOTE %()
EMACS.TEMP.FILE)
(PRIN3 (QUOTE DEFINEQ)
EMACS.TEMP.FILE)
(PRIN3 (QUOTE % )
EMACS.TEMP.FILE)
(PRIN3 (QUOTE %()
EMACS.TEMP.FILE)
(PRIN4 (CAADR X)
EMACS.TEMP.FILE)
(PRIN3 (QUOTE % )
EMACS.TEMP.FILE)
(DUMPX1 (CAR (CDADR X))
NIL)
(PRIN3 (QUOTE %))
EMACS.TEMP.FILE)
(PRIN3 (QUOTE %))
EMACS.TEMP.FILE))
(T (DUMPX1 X NIL)))))
(DUMPX1
(LAMBDA (X DEF LEFT)
(* We prettyprint into EMACS.TEMP.FILE.
We set the LINELENGTH to 79 because EMACS stupidly
causes wraparound at 80 (instead of 81). The
GETCOMMENT stuff causes lisp comments that are
currently mapped out (because NORMALCOMMENTSFLG is
NIL) to get sent down to EMACS.)
(RESETFORM
(LINELENGTH 79)
(RESETFORM (OUTFILE EMACS.TEMP.FILE)
(PROG (FONTCHANGEFLG
(PRETTYPRINTMACROS
(APPEND (QUOTE ( (* . GETCOMMENT)
(QUOTE . MAKE.QUOTE)))
PRETTYPRINTMACROS)))
(PRINTDEF X LEFT DEF)
(RETURN NIL))))))
(E!
(LAMBDA (N FN)
(MAP.BYTES EMACS.PT EMACS.ZV)
(COND
((AND (NUMBERP N)
(GREATERP N 0))
(for I from 1 to N do (E.1 FN)))
(T (PROG (OLDLOC)
LOOP(SETQ OLDLOC (GETFILEPTR EMACS.MAP.FILE))
(while (AND (LESSP (GETFILEPTR EMACS.MAP.FILE)
EMACS.MAP.FILE.EOF)
(SYNTAXP (CHCON1 (PEEKC EMACS.MAP.FILE NIL))
(QUOTE SEPR)
EMACS.READ.TABLE))
do (READC EMACS.MAP.FILE))
(COND
((LESSP (GETFILEPTR EMACS.MAP.FILE)
EMACS.MAP.FILE.EOF)
(SETFILEPTR EMACS.MAP.FILE OLDLOC)
(E.1 FN)
(GO LOOP))
(T (RETURN))))))
(CHARACTER 8)))
(E.
(LAMBDA (FN)
(MAP.BYTES EMACS.PT EMACS.ZV)
(E.1 FN)))
(E.1
(LAMBDA (FN)
(* This function is for calling after DOWN has
returned. It causes the LISP expression after point
in the EMACS buffer to be read and evaluated in one
of several ways. The appropriate form is evaluated
with LISPXEVAL so that it becomes
(somewhat) undoable, just as if you had literally
typed it into LISP.)
(PROG (TEMP)
(SETQ TEMP (PROG ((NORMALCOMMENTSFLG T))
(* We must make lisp read in the comments because
text in the buffer is very likely to get deleted or
edited.)
(RETURN (READ EMACS.MAP.FILE
EMACS.READ.TABLE))))
(PROMPTCHAR (QUOTE _)
T LISPXHISTORY)
(SETQ TEMP (SELECTQ FN
(DEFINEQ (LIST (QUOTE DEFINEQ)
TEMP))
(QUOTE (LIST (QUOTE QUOTE)
TEMP))
TEMP))
(RESETFORM (PRINTLEVEL (QUOTE (3 . 4))
NIL)
(PRINT TEMP T))
(SETQ TEMP (ENVEVAL (LIST (QUOTE LISPXEVAL)
(KWOTE TEMP)
NIL)
T))
(RESETFORM (PRINTLEVEL (QUOTE (3 . 4))
NIL)
(PRINT TEMP T))
(RETURN (CHARACTER 8)))))
(EDIT.DRIBBLE.FILE
(LAMBDA NIL
(PROG (FILE)
(SETQ FILE (DRIBBLEFILE))
(COND
((NULL FILE)
(ERROR "No dribble file!")))
(DRIBBLE NIL NIL NIL)
(OPENFILE FILE (QUOTE BOTH)
(QUOTE OLD)
NIL
(QUOTE (THAWED)))
(IOFILE FILE)
(DRIBBLE FILE T T)
(SETFILEPTR FILE (GETEOFPTR FILE))
(PRIN3 "M(M.MSelect Buffer)*LISP-DRIBBLE*
E[FNE]
2,ER" EMACS.TEMP.FILE)
(PRIN3 FANCY.DRIBBLE.FILE EMACS.TEMP.FILE)
(PRIN3 "@Y
0FSDVERSION
ZJ
-1FSPJATY
" EMACS.TEMP.FILE)
(DOWN T)
(RETURN NIL))))
(EMACS
(LAMBDA (OLDBUFFER)
(CHECK.EMACS)
(COND
(OLDBUFFER (DOWN NIL))
(T (SETFILEPTR EMACS.TEMP.FILE 0)
(PRIN3 "
" EMACS.TEMP.FILE)
(DOWN NIL)))))
(EMACS.?=
(LAMBDA NIL
(PROG (NAME)
(MAP.BYTES EMACS.PT EMACS.ZV)
(COND
((EQ (SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE))
(QUOTE %())
(SETQ NAME (RATOM EMACS.MAP.FILE EMACS.READ.TABLE))))
(DISPLAY.IN.OTHER.WINDOW
(COND
((GETD NAME)
(CONS
NAME
(CONS
"["
(NCONC1
(COND
((NLISTP (ARGLIST NAME))
(LIST (ARGLIST NAME)))
(T (for ARGLIST on (ARGLIST NAME)
join (CONS (CAR ARGLIST)
(COND
((NULL (CDR ARGLIST))
NIL)
(T (CONS "," NIL)))))))
"]"))))
(T (LIST "Not a function."))))
(RETURN NIL))))
(EMACS.EOF.ERROR
(LAMBDA (FILE)
(ERROR "EOF Error for " FILE T)))
(EMACS.EVAL.CURRENT.SEXPR
(LAMBDA NIL (* edited:
"15-Apr-80 15:55")
(MAP.BYTES EMACS.PT EMACS.ZV)
(PRIN3
"0FO..QWindow 2 Size%"E
M(M.M^R Two Windows)'
%"#M(M.M^R Other Window)'
M(M.MSelect Buffer)*LISP-PRINT*
HK
GA 0J 10K
QWindow 2 Size-3%"N 3-QWindow 2 SizeM(M.M^R Grow Window)'
M(M.M^R Other Window)
M(M.M& Multi-Window Refresh)
"
EMACS.TEMP.FILE)
(PROG ((PLVLFILEFLG T)
FORM)
(SETQ FORM
(ENVEVAL (LIST (QUOTE NLSETQ)
(LIST (QUOTE LISPXEVAL)
(KWOTE (PROG ((NORMALCOMMENTSFLG
T))
(RETURN (READ
EMACS.MAP.FILE
EMACS.READ.TABLE)))))
)
T))
(PRIN3 (COND
(FORM (CAR FORM))
(T "Can't evaluate this form"))
EMACS.TEMP.FILE)
(RETURN NIL))
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1 T))
NIL NIL)))
(EMACS.FIND.SEXP
(LAMBDA NIL (* edited:
"21-Jan-80 08:59")
(PROG ((OCCNTR 0)
(NORMALCOMMENTSFLG T)
#2)
(MAP.BYTES EMACS.PT EMACS.ZV)
(FIND.SEXP (READ EMACS.MAP.FILE EMACS.READ.TABLE)
#2)
(RETURN (COND
((LISTP #2)
(LIST (LIST (QUOTE F)
#2 OCCNTR)))
(T (ERROR "Pat not found." NIL T)))))))
(EMACS.GETDEF
(LAMBDA (NAME)
(PROG (DEF FILE SPOT MAP)
(COND
((NULL NAME)
(SETQ NAME LASTWORD)
(PRIN1 (QUOTE =)
T)
(PRINT LASTWORD T))
((NOT (LITATOM NAME))
(ERROR NAME)))
(COND
((OR (LISTP (GETD NAME))
(GETP NAME (QUOTE EXPR)))
(DUMPX (LIST (QUOTE DEFINEQ)
(LIST NAME (GETDEF NAME))))
(RETURN (DOWN NIL)))) (* Perhaps the defintion
is on a file.)
(SETQ FILE (CAR (WHEREIS NAME)))
(COND
((AND
FILE EMACS.FASTREADFLG
(OR
(AND (SETQ MAP (GETP FILE (QUOTE FILEMAP)))
(SETQ SPOT (ASSOC NAME (CDDR (CADADR MAP)))))
(PROGN
(PRIN1 "Getting FILEMAP for " T)
(PRINT (CDAR (GETP FILE (QUOTE FILEDATES)))
T)
(LOADFNS NIL
(PACKFILENAME
(UNPACKFILENAME
(CDAR (GETP FILE (QUOTE FILEDATES)))))
T
(QUOTE ((DECLARE: -- (FILEMAP --)
--))))
(* What a creaky way to
get the filemap in.)
(AND (SETQ MAP (GETP FILE (QUOTE FILEMAP)))
(SETQ SPOT (ASSOC NAME (CDDR (CADADR MAP)))))))
)
(RESETFORM (RADIX 10)
(PROGN (SETQ FILE (CDAR (GETP FILE
(QUOTE FILEDATES)
)))
(PRINT FILE T)
(PRIN3 (CADR SPOT)
EMACS.TEMP.FILE)
(PRIN3 (QUOTE ,)
EMACS.TEMP.FILE)
(PRIN3 (DIFFERENCE (CDDR SPOT)
(CADR SPOT))
EMACS.TEMP.FILE)
(PRIN3 "M(M.M& Getdef)"
EMACS.TEMP.FILE)
(PRIN3 FILE EMACS.TEMP.FILE)
(PRIN3 (QUOTE )
EMACS.TEMP.FILE)))
(RETURN (DOWN T)))
((SETQ DEF (GETDEF NAME))
(* We give up and appeal to those who "know" where
the definition really is.)
(DUMPX (LIST (QUOTE DEFINEQ)
(LIST NAME DEF)))
(RETURN (DOWN NIL))))
(ERROR "No Definition Found. " NAME))))
(EMACS.P
(LAMBDA NIL
(MAP.BYTES EMACS.PT EMACS.ZV) (* See the comment in
PPTI.)
(PRIN3
"0FO..QWindow 2 Size%"E
M(M.M^R Two Windows)'
%"#M(M.M^R Other Window)'
M(M.MSelect Buffer)*LISP-PRINT*
HK GA 0J
10K
QWindow 2 Size-3%"N 3-QWindow 2 SizeM(M.M^R Grow Window)'
M(M.M^R Other Window)
M(M.M& Multi-Window Refresh)
"
EMACS.TEMP.FILE)
(PROG ((PLVLFILEFLG T))
(RESETFORM (PRINTLEVEL EMACS.P.PRINT.LEVEL NIL)
(PRIN3 (PROG ((NORMALCOMMENTSFLG T))
(RETURN (READ EMACS.MAP.FILE
EMACS.READ.TABLE)))
EMACS.TEMP.FILE))
(RETURN NIL))
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1 T))
NIL NIL)))
(EMACS.PP
(LAMBDA (HPOS)
(MAP.BYTES EMACS.PT EMACS.ZV)
(PROG ((NORMALCOMMENSFLG T)
START FORM TO.DELETE MAP.END)
(SETQ START (GETFILEPTR EMACS.MAP.FILE))
(SETQ FORM (NLSETQ (READ EMACS.MAP.FILE EMACS.READ.TABLE)))
(COND
((OR (NULL FORM (GREATERP (GETFILEPTR EMACS.MAP.FILE)
EMACS.ZV)))
(PRIN3 "FTREAD failed." EMACS.TEMP.FILE)
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1 T))
NIL NIL)))
(SETQ TO.DELETE (DIFFERENCE (GETFILEPTR EMACS.MAP.FILE)
START))
(SETQ FORM (CAR FORM))
(SPACES 100 EMACS.TEMP.FILE)
(TERPRI EMACS.TEMP.FILE)
(* We leave a first line of 100 characters for TECO
code. The code should end with a
control-back-square-bracket and not contain any CRs
or LFs.)
(POSITION EMACS.TEMP.FILE HPOS) (* Causes the PRINTDEF
in DUMPX not to print
leading spaces.)
(DUMPX1 FORM NIL HPOS)
(SETQ MAP.END (GETFILEPTR EMACS.TEMP.FILE))
(SETFILEPTR EMACS.TEMP.FILE 0)
(PRIN3 TO.DELETE EMACS.TEMP.FILE)
(PRIN3
",(104,(FQA):GA)M(M.M& Prettyprint Undoably Replace) "
EMACS.TEMP.FILE)
(SETFILEPTR EMACS.TEMP.FILE MAP.END)
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1 T))
NIL NIL))))
(EMACS.REPLACE.SEXP
(LAMBDA NIL
(MAP.BYTES EMACS.PT EMACS.ZV)
(PROG (TEMP)
(SETQ TEMP (PROG ((NORMALCOMMENTSFLG T))
(RETURN (READ EMACS.MAP.FILE
EMACS.READ.TABLE))))
(RETURN (LIST (QUOTE ORR)
(LIST (LIST (QUOTE :)
TEMP))
(LIST (QUOTE (BI 1 -1))
(LIST 1 TEMP)
(QUOTE (BO 1))))))))
(EMACS.RETURN
(LAMBDA NIL (* edited:
" 7-Jan-80 08:41")
(PROG (ARG1 ARG2)
(SETQ ARG1 (LLSH EMACS.FSEXIT.ARG -18))
(SETQ ARG2 (LOGAND EMACS.FSEXIT.ARG 262143))
(SELECTQ ARG1
(1 (DUMP.LINES?)
(E! ARG2 NIL))
(2 (DUMP.LINES?)
(E! ARG2 (QUOTE DEFINEQ)))
(3 (DUMP.LINES?)
(E! ARG2 (QUOTE QUOTE)))
(4 (EMACS.PP ARG2))
(5 (EMACS.P))
(6 (EMACS.?=))
(7 (ERROR "
ERROR return from EMACS." NIL T))
(8 (PRIN1 "
RESET return from EMACS." T)
(RESET))
(9 (EMACS.EVAL.CURRENT.SEXPR))
(10 (RETURN (PROGN (DUMP.LINES?)
(EMACS.FIND.SEXP))))
(11 (RETURN (PROGN (DUMP.LINES?)
(EMACS.REPLACE.SEXP))))
(PROGN (DUMP.LINES?)))
(RETURN (CHARACTER 127)))))
(EMACS:.RETURN
(LAMBDA NIL (* edited:
"18-Jan-80 15:36")
(PROG (ARG1)
(SETQ ARG1 (LLSH EMACS.FSEXIT.ARG -18))
(SELECTQ ARG1
(4 (EMACS.PP))
(5 (EMACS.P))
(6 (EMACS.?=))
(7 (ERROR "
ERROR return from EMACS." NIL T))
(8 (PRIN1 "
RESET return from EMACS." T)
(RESET))
(9 (EMACS.EVAL.CURRENT.SEXPR))
(10 (RETURN (PROGN (DUMP.LINES?)
(EMACS.FIND.SEXP))))
(11 (RETURN (PROGN (DUMP.LINES?)
(EMACS.REPLACE.SEXP))))
(PROGN (PRINT
"In appropriate exit from EMACS. Use C-T C-E if you want
to quit back to EDITE:. Returning to EMACS"
T)
(DISMISS 3000)
(RETEVAL (QUOTE DOWN1)
(QUOTE (DOWN1))
NIL NIL)))
(RETURN (CHARACTER 127)))))
(ENABLE.CONTROL.C.CAPABILITY
(LAMBDA NIL
(JSYS 105 OURPROCESS 0 (,, 131072 0))))
(EMACS.EXE.FILE
(LAMBDA NIL
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(QUOTE <SUBSYS>EMACS.SAV))
(T (QUOTE SYS:EMACS.EXE)))))
(FIND.SEXP
(LAMBDA (SEXP PAT) (* edited:
"23-Dec-79 19:46")
(COND
((NULL SEXP)
NIL)
((EQ SEXP PAT)
(SETQ OCCNTR (ADD1 OCCNTR))
T)
(T (COND
((EQUAL SEXP PAT)
(SETQ OCCNTR (ADD1 OCCNTR))))
(COND
((LISTP SEXP)
(COND
((FIND.SEXP (CAR SEXP)
PAT))
((FIND.SEXP (CDR SEXP)
PAT))
(T NIL))))))))
(FLUSH.EMACS
(LAMBDA NIL
(COND
((LISTP LASTEMACS)
(* This function gets rid of the EMACS fork and
closes the 3 files that EMACS uses.)
(JSYS 46 -1 (,, OURPROCESS EMACS.MAP.BLK.PAGE))
(JSYS 46 -1 (,, OURPROCESS (LSH OUR.BLOCK.START -9)))
(COND
((EQP EMACS.BLK.SIZE 2)
(JSYS 46 -1 (,, OURPROCESS (ADD1 (LSH OUR.BLOCK.START -9))))
))
(COND
((FIXP (CAR (GETATOMVAL (QUOTE LASTEMACS))))
(KFORK (CAR (GETATOMVAL (QUOTE LASTEMACS))))))
(SETQ LASTEMACS NIL)
(* We don't want FLUSH.EMACS called twice on the
same EMACS because the PMAPS above are potentially
disasterous if the pages are already allocated in
LISP to some datatype.)
(COND
((AND (NEQ (QUOTE NOBIND)
(GETATOMVAL (QUOTE EMACS.MAP.FILE)))
(LITATOM EMACS.MAP.FILE)
(OPENP EMACS.MAP.FILE))
(CLOSEF EMACS.MAP.FILE)))
(COND
((AND (NEQ (QUOTE NOBIND)
(GETATOMVAL (QUOTE EMACS.TEMP.FILE)))
(LITATOM EMACS.TEMP.FILE)
(OPENP EMACS.TEMP.FILE))
(CLOSEF EMACS.TEMP.FILE)))
(COND
((AND (NEQ (QUOTE NOBIND)
(GETATOMVAL (QUOTE FANCY.DRIBBLE.FILE)))
(LITATOM FANCY.DRIBBLE.FILE)
(OPENP FANCY.DRIBBLE.FILE))
(DRIBBLE NIL NIL NIL)))
(NLSETQ (RELBLK EMACS.MAP.BLK 1))
(NLSETQ (RELBLK (VAG OUR.BLOCK.START)
EMACS.BLK.SIZE))
(NLSETQ (RELBLK (VAG EMACS.AC.BLK.START)
1))))))
(GET.BYTE
(LAMBDA (N FIRSTLOC)
(LOGAND 127 (LLSH (OPENR (IPLUS FIRSTLOC (IQUOTIENT N 5)))
(SUB1 (ITIMES (IDIFFERENCE (IREMAINDER N 5)
4)
7))))))
(INTER.DIRECTORYNAME
(LAMBDA NIL
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(PACK* (QUOTE <)
(DIRECTORYNAME NIL NIL)
(QUOTE >)))
(T (DIRECTORYNAME NIL NIL)))))
(MAKE.QUOTE
(LAMBDA (X)
(COND
((AND (LISTP (CDR X))
(LITATOM (CADR X))
(NULL (CDDR X))
(EQUAL X (KWOTE (CADR X))))
(PACK* (QUOTE ')
(CADR X)))
(T (CONS (QUOTE QUOTE)
(CDR X))))))
(MAP.BYTES
(LAMBDA (START END)
(PROG (PTR NCHARS)
(* START must be greater than or equal to END.
Both refer to byte addresses in the TECO buffer,
such as are found in the buffer block.
Either may need to have EXTRAC addded to it to be
vaild.)
(SETQ NCHARS (ADD1 (IDIFFERENCE END START)))
(* The ADD1 is for the space that we add at the end
to permit LISP to READ an atom, if that is the last
thing in the buffer.)
(* As always,
EMACS.MAP.FILE.EOF
should equal
(GETEOFPTR
EMACS.MAP.FILE))
(* When we exit, the contents of the EMACS buffer
from start to end will have been written to
EMACS.MAP.FILE. The contents will start at the file
pointer of EMACS.MAP.FILE and will end at the end of
the file. EMACS.MAP.FILE.EOF will contain
(GETEOFPTR EMACS.MAP.FILE).)
(COND
((ILEQ NCHARS EMACS.MAP.FILE.EOF)
(SETQ PTR (IDIFFERENCE EMACS.MAP.FILE.EOF NCHARS)))
(T (SETQ PTR 0)
(SETFILEPTR EMACS.MAP.FILE NCHARS)
(SETQ EMACS.MAP.FILE.EOF NCHARS)))
(* If necessary, we
lengthen the file and
adjust
EMACS.MAP.FILE.EOF.)
(SETFILEPTR EMACS.MAP.FILE PTR)
(* We use the information about the gap in the TECO
buffer presented in <INFO>TECORD.
There are three cases, depending upon how GPT stands
with respect to START and END.)
(COND
((IGEQ START EMACS.GPT)
(* The gap starts at or before START, so we add
EXTRAC to both and don't have to do two writes.)
(MAP.BYTES1 (IPLUS START EMACS.EXTRAC)
(IPLUS END EMACS.EXTRAC)))
((ILEQ END EMACS.GPT)
(* The gap starts at or after END.
Since we actually don't write the character at END,
we do not have to add EXTRAC to either.)
(MAP.BYTES1 START END))
(T (* The gap is strictly
between START and END.)
(MAP.BYTES1 START EMACS.GPT)
(MAP.BYTES1 (IPLUS EMACS.GPT EMACS.EXTRAC)
(IPLUS END EMACS.EXTRAC))))
(SPACES 1 EMACS.MAP.FILE)
(SETFILEPTR EMACS.MAP.FILE PTR)
(RETURN NIL))))
(MAP.BYTES1
(LAMBDA (START END) (* The writing is done a
page at a time.)
(for I from (PAGE.OF.BYTE START) to (PAGE.OF.BYTE END)
do (MAP.PROCESS.TO.FILE (CAR LASTEMACS)
I EMACS.MAP.FILE.JFN
(COND
((EQP I (PAGE.OF.BYTE START))
(IREMAINDER START 2560))
(T 0))
(COND
((EQP I (PAGE.OF.BYTE END))
(IREMAINDER END 2560))
(T 2560))))))
(MAP.PROCESS.TO.FILE
(LAMBDA (PROCESS PAGE JFN START.BYTE END.BYTE)
(JSYS 46 -1 (,, OURPROCESS EMACS.MAP.BLK.PAGE))
(* We unmap
EMACS.MAP.BLK.PAGE)
(JSYS 46 (,, PROCESS PAGE)
(,, OURPROCESS EMACS.MAP.BLK.PAGE)
(,, 33024 0)) (* We map PAGE in EMACS
into
EMACS.MAP.BLK.PAGE.)
(JSYS 43 JFN (BYTEPOINTER (LOC EMACS.MAP.BLK)
START.BYTE)
(IDIFFERENCE END.BYTE START.BYTE)) (* We write the relevant
portion of the page to
JFN.)
NIL))
(PAGE.OF.BYTE
(LAMBDA (BYTE)
(PROG (QUO REM)
(SETQ QUO (IQUOTIENT BYTE 5))
(SETQ REM (IREMAINDER BYTE 5))
(RETURN (LLSH (COND
((ZEROP REM)
(ADD1 QUO))
(T QUO))
-9)))))
(PAGEMODE
(LAMBDA (FLG)
(* Returns Y if in page mode, N if not.
FLG should be Y, N, or NIL, the latter for no
effect.)
(PROG (JFNMODE)
(SETQ JFNMODE (JSYS 71 65 NIL NIL 2))
(COND
(FLG (JSYS 143 65 (SELECTQ FLG
(Y (LOGOR JFNMODE 2))
(LOGAND JFNMODE
(LOGXOR 2 -1))))))
(RETURN (SELECTQ (LOGAND 2 JFNMODE)
(2 (QUOTE Y))
(QUOTE N))))))
(PPTI
(NLAMBDA LST
(* This is monstrous code. All that is printed will
be placed in q-register A and macroed.
The GA, hence, will obtain the text that is
currently being macroed and the 6K will delete all
of the instructions, proper, leaving only the pretty
printed text that is to be TIed.
What lead to this freak? The difficulty of setting
up a TECO command capable of inserting a string of
characters without knowing that some particular
character delimits, but does not occur in, the text
being inserted. Since LISP code is likely to contain
any of the ASCII characters, what else could we do?)
(PRIN3
"FSBCONS[..O
GA
0J 6K
M(M.MTI Print)
]..O
M(M.M^R Exit to LISP)
"
EMACS.TEMP.FILE)
(RESETFORM (OUTPUT EMACS.TEMP.FILE)
(PROG (PRETTYTABFLG (NORMALCOMMENTSFLG T))
(APPLY (FUNCTION PRETTYPRINT)
(LIST LST))
(RETURN NIL)))
(DOWN T)))
(PUTSTRING
(LAMBDA (STR ADDR)
(* We write the bytes in STR starting a ADDR 5 bytes
(of 7 bits each) to a word with a 0 bit at the end.
We make sure that a 0 byte is added at the end.
In fact, the last word ends with 0 bytes.)
(until (GREATERP CHAR (ADD1 (NCHARS STR))) bind LOC
first (SETQ LOC ADDR) bind WORD bind CHAR first (SETQ CHAR 1)
do (SETQ WORD 0)
(for J from 1 to 5
do (SETQ WORD (LLSH WORD 7))
(SETQ WORD (LOGOR WORD
(COND
((GREATERP CHAR (NCHARS STR))
0)
(T (CHCON1 (NTHCHAR STR CHAR))))))
(SETQ CHAR (ADD1 CHAR)))
(CLOSER LOC (LLSH WORD 1))
(SETQ LOC (ADD1 LOC)))
ADDR))
(READ.AC
(LAMBDA (ACN PROCESS)
(JSYS 113 PROCESS EMACS.AC.BLK.START)
(OPENR (LOGOR EMACS.AC.BLK.START ACN))))
(REFRESH
(LAMBDA NIL (* edited:
"20-Nov-79 10:08")
(* We look up the number
of lines on the terminal
with RFMOD.)
(DUMP.LINES (SUB1 (LOGAND 127
(LLSH (JSYS 71 65 NIL NIL 2)
-25))))
(CHARACTER 127)))
(SET.EMACS.VARS
(LAMBDA NIL
(* Sets LISP variables to the contents of the EMACS
buffer block, as documented in <INFO>TECORD.)
(SETQ EMACS.BEG (OPENR EMACS.BEG.LOC))
(SETQ EMACS.BEGV (OPENR EMACS.BEGV.LOC))
(SETQ EMACS.GPT (OPENR EMACS.GPT.LOC))
(SETQ EMACS.PT (OPENR EMACS.PT.LOC))
(SETQ EMACS.ZV (OPENR EMACS.ZV.LOC))
(SETQ EMACS.Z (OPENR EMACS.Z.LOC))
(SETQ EMACS.EXTRAC (OPENR EMACS.EXTRAC.LOC))
(SETQ EMACS.MODIFF (OPENR EMACS.MODIFF.LOC))
(SETQ EMACS.FSEXIT.ARG (READ.AC 3 (CAR LASTEMACS)))))
(SETUP.FANCY.DRIBBLE
(LAMBDA NIL
(* To refresh the screen upon returning to LISP, we
use the dribble file to find out what was recently
typed. We first open the file with IOFILE.
Kindly, DRIBBLE lets us get away with that, because
if you first open a dribble file, you can't open it
for read later.)
(PROG (REAL.NUMBER) (* How many lines on the
terminal?)
(SETQ REAL.NUMBER (LOGAND 127 (LLSH (JSYS 71 65 NIL NIL 2)
-25)))
(COND
((ZEROP REAL.NUMBER)
(SETQ REAL.NUMBER 24)))
(COND
((DRIBBLEFILE)
(SETQ FANCY.DRIBBLE.FILE (CONS NIL NIL)))
(T (SETQ FANCY.DRIBBLE.FILE
(OUTPUT (OUTFILE (PACK* (INTER.DIRECTORYNAME)
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(QUOTE
LISP.DRIBBLE;-1;TP770000))
(T (QUOTE
LISP.DRIBBLE.-1;T;P770000)))))
))
(CLOSEF FANCY.DRIBBLE.FILE)
(IOFILE FANCY.DRIBBLE.FILE)
(DRIBBLE FANCY.DRIBBLE.FILE T T)
(SETQ NUMBER.OF.LINES
(IMIN REAL.NUMBER
(IQUOTIENT (TIMES TERMINAL.SPEED REAL.NUMBER)
9600)))))
(RETURN NIL))))
(START.EMACS
(LAMBDA NIL
(PROG (NAME RSCAN.BLK (SUBSYSRESCANFLG T))
(SETQ #RPARS NIL)
(SETQ EMACS.READ.TABLE (COPYREADTABLE FILERDTBL))
(SETSYNTAX 2 (QUOTE (MACRO FIRST (LAMBDA (FL RDTBL)
(SETQ #2 (READ FL RDTBL)))))
EMACS.READ.TABLE)
(SETSYNTAX (QUOTE ')
(GETSYNTAX (QUOTE ')
(GETREADTABLE T))
EMACS.READ.TABLE)
(* Since the user will naturally type in single
quote marks, we want them to get turned into
QUOTE's. Unfortunately, INTERLISP does not do that
when reading from a file (with the default
FILEREADTBL.))
(COND
(LASTEMACS (FLUSH.EMACS)))
(* Our first step is always to get rid of any EMACS
fork and associated files around.)
(SETQ EMACS.TEMP.FILE
(OUTPUT (OUTFILE (PACK* (INTER.DIRECTORYNAME)
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(QUOTE EMACS.TEMP;-1;TP770000))
(T (QUOTE EMACS.TEMP.-1;T;P770000)
))))))
(* EMACS.TEMP.FILE will be the file to which we
print in LISP and from which EMACS reads via
FSSUPERIOR.)
(SETFILEPTR EMACS.TEMP.FILE MAX.EMACS.INPUT)
(* We confuse EMACS into
thinking that it is a
very big file.)
(SPACES 1 EMACS.TEMP.FILE)
(CLOSEF EMACS.TEMP.FILE)
(OPENFILE EMACS.TEMP.FILE (QUOTE BOTH)
(QUOTE OLD)
NIL
(QUOTE (THAWED)))
(* We IOFILE the temp file so that we can write it
and EMACS can read it.)
(SETQ NAME (MKATOM (SIXBIT (JSYS 127))))
(* We are going to SETNM
and want to restore.)
(SETNM (QUOTE LISP))
(SETQ RSCAN.BLK (LOC (GETBLK 1)))
(* We now put into the RSCAN area a string that
EMACS will execute when it is fired up.
The string that EMACS obtains via FJ is the string
put into the RSCAN minus the first word.
EMACS executes the TECO code after the first altmode
in the JCL returned by FJ. This execution is coded
in <EMACS>EMACS.INIT.)
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(BKSYSBUF (CONCAT "M(M.MLOAD LIB)<" INTER.DIRECTORY
">INTERWFSOSPEEDFSEXIT")))
(T (WRITE.RSCAN (CONCAT "EMACS M(M.MLoad Lib)<"
INTER.DIRECTORY
">INTERWFSOSPEEDFSEXIT"))))
(RELBLK (VAG RSCAN.BLK)
1) (* We need the RSCAN
block no more.)
(SETQ LASTEMACS (SUBSYS2 (EMACS.EXE.FILE)
NIL NIL NIL NIL))
(COND
((NEQ NAME (QUOTE LISP))
(SETNM NAME)))
(SETQ EMACS.AC.BLK.START (LOC (GETBLK 1)))
(SETQ EMACS.BUFFER.BLOCK (READ.AC 2 (CAR LASTEMACS)))
(* AC2 contains the
beginning of EMACS'
buffer block.
See <INFO>TECORD.)
(COND
((EQP (LLSH EMACS.BUFFER.BLOCK -9)
(LLSH (PLUS EMACS.BUFFER.BLOCK 9)
-9))
(SETQ EMACS.BLK.SIZE 1))
(T (SETQ EMACS.BLK.SIZE 2)))
(* We aim to map in the EMACS buffer block into LISP
so that we can see what's gone on down there and so
that we can give an arg to FSSUPERIOR.
We may need one page or two depending upon where the
buffer lies.)
(SETQ OUR.BLOCK.START (LOC (GETBLK EMACS.BLK.SIZE)))
(* We grab a block (or two) from LISP and save
(the boxed) start.)
(for VAR
in (QUOTE (EMACS.BEG.LOC EMACS.BEGV.LOC EMACS.PT.LOC
EMACS.GPT.LOC EMACS.ZV.LOC
EMACS.Z.LOC EMACS.EXTRAC.LOC
EMACS.RESTART.LOC EMACS.ARG.LOC
EMACS.MODIFF.LOC))
as I from 0 do (SET VAR (PLUS I (LOGOR OUR.BLOCK.START
(LOGAND 511
EMACS.BUFFER.BLOCK)))))
(* We set the values of variables to be the location
(in LISP) of the EMACS buffer block contents.)
(* Now map the EMACS
buffer block page
(s) in.)
(JSYS 46 (,, (CAR LASTEMACS)
(LLSH EMACS.BUFFER.BLOCK -9))
(,, OURPROCESS (LLSH OUR.BLOCK.START -9))
(,, 53248 0))
(COND
((EQP EMACS.BLK.SIZE 2)
(JSYS 46 (,, (CAR LASTEMACS)
(ADD1 (LLSH EMACS.BUFFER.BLOCK -9)))
(,, OURPROCESS (ADD1 (LLSH OUR.BLOCK.START -9)))
(,, 53248 0))))
(* Now we put the entry vector for EMACS at the end
of the buffer block. When we start up the fork again
with SUBSYS1 (which calls SUBSYS) we will ask for
the process to be STARTed. This causes control to go
to FSSUPERIOR, since the entry vector is sitting at
the location one is supposed to commence to get
FSSUPERIOR fired up.)
(JSYS 132 (CAR LASTEMACS)
(,, 1 (PLUS EMACS.BUFFER.BLOCK 7)))
(SETQ EMACS.MAP.FILE
(OUTPUT (OUTFILE (PACK* (INTER.DIRECTORYNAME)
(COND
((EQ (SYSTEMTYPE)
(QUOTE TENEX))
(QUOTE EMACS.MAP;-1;TP770000))
(T (QUOTE EMACS.MAP.-1;T;P770000))
)))))
(* EMACS.MAP.FILE is the file into which we will
PMAP the buffer pages of EMACS.
We read from that file to get the value of the edits
performed.)
(CLOSEF EMACS.MAP.FILE)
(IOFILE EMACS.MAP.FILE)
(* We have to have the map file open for read and
for write. We first create a file, then close it,
and then open it with IOFILE.)
(SETQ EMACS.MAP.FILE.EOF 0)
(* To avoid needless calls of GETEOFPTR and
SETFILEPTR we keep track of the maximum we have set
the EOF pointer to.)
(SETQ EMACS.MAP.FILE.JFN (OPNJFN EMACS.MAP.FILE))
(SETQ EMACS.MAP.BLK (GETBLK 1))
(SETQ EMACS.MAP.BLK.PAGE (LLSH (LOC EMACS.MAP.BLK)
-9))
(SETQ TERMINAL.SPEED (READ.AC 3 (CAR LASTEMACS)))
(SETUP.FANCY.DRIBBLE)
(TERPRI T)
(TERPRI T)
(WHENCLOSE EMACS.MAP.FILE (QUOTE CLOSEALL)
(QUOTE NO)
(QUOTE EOF)
(QUOTE EMACS.EOF.ERROR))
(WHENCLOSE EMACS.TEMP.FILE (QUOTE CLOSEALL)
(QUOTE NO)
(QUOTE EOF)
(QUOTE EMACS.EOF.ERROR))
(EVAL EMACS.INIT.HOOK)
(RETURN (QUOTE Continue)))))
(STIW
(LAMBDA (W)
(PROG1 (JSYS 123 -5 NIL NIL 2)
(COND
(W (JSYS 124 -5 W))))))
(SUBSYS1
(LAMBDA (TWO INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE)
(* Interlisp's SUBSYS does not work when the process
started up fiddles with the terminal interrupt words
or the binary/ascii mode word.
SUBSYS1 returns a two-tuple containing the lower
process handle and the tiw. Also, an extra arg
permits the forcing of entry into binary mode when
the lower process is restarted.
(A call in SUBSYS to SFMOD prevents us from
determining whether the lower process was in binary
mode.) Clearly, someone should do SUBSYS right.
SUBSYS0 is just the unadvised version of SUBSYS.)
(PROG (FORK TIW)
(COND
((LITATOM TWO)
(ENABLE.CONTROL.C.CAPABILITY)
(SETQ FORK TWO)
(SETQ TIW (STIW NIL)))
(T (SETQ FORK (CAR TWO))
(SETQ TIW (CADR TWO))))
(RETURN (RESETFORM (PAGEMODE (QUOTE N))
(RESETFORM
(STIW TIW)
(PROGN (COND
(BINARYMODE (BINARYMODE)))
(LIST (SUBSYS0 FORK INCOMFILE
OUTCOMFILE
ENTRYPOINTFLG)
(LOGAND (LOGXOR 32768 -1)
(STIW NIL))))))))))
(SUBSYS2
(LAMBDA (THREE INCOMFILE OUTCOMFILE ENTRYPOINTFLG BINARYMODE)
(PROG (FORKTHREE)
(SETQ FORKTHREE (SUBSYS1 THREE INCOMFILE OUTCOMFILE
ENTRYPOINTFLG BINARYMODE))
CONTROL-C-LOOP
(COND
((NOT (ZEROP (LOGAND 17179869184 (JSYS 93 (CAR FORKTHREE)
NIL NIL 2))))
(* True if and only if
EMACS was exited with a
control-c.)
(JSYS 120)
(DISMISS 1000)
(* We dismiss to permit the operating system to
arrange for the left half of ac1 returned by RFSTS
on the EMACS fork to be 2 instead of 0.0 This is a
horrible hack that is necessitated by a poor
implementation of RFSTS.)
(SETQ FORKTHREE (SUBSYS1 FORKTHREE NIL NIL NIL T))
(GO CONTROL-C-LOOP))
(T (RETURN FORKTHREE))))))
(WRITE.RSCAN
(LAMBDA (STR)
(PUTSTRING STR RSCAN.BLK) (* RSCAN)
(JSYS 320 (LOGOR (LLSH 147904 18)
RSCAN.BLK))))
)
(RPAQQ INTERVARS (INTER.DIRECTORY EMACS.FASTREADFLG EMACS.P.PRINT.LEVEL
OURPROCESS MAX.EMACS.INPUT
(LASTEMACS NIL)
(EMACS.RETURN.CASES (QUOTE
EMACS.RETURN))
(EMACS.ENTRY.HOOK NIL)
(EMACS.EXIT.HOOK NIL)
(EMACS.INIT.HOOK NIL)))
(RPAQQ INTER.DIRECTORY EMACS)
(RPAQQ EMACS.FASTREADFLG T)
(RPAQQ EMACS.P.PRINT.LEVEL (2 . 7))
(RPAQQ OURPROCESS 131072)
(RPAQQ MAX.EMACS.INPUT 896000)
(RPAQ LASTEMACS NIL)
(RPAQQ EMACS.RETURN.CASES EMACS.RETURN)
(RPAQ EMACS.ENTRY.HOOK NIL)
(RPAQ EMACS.EXIT.HOOK NIL)
(RPAQ EMACS.INIT.HOOK NIL)
(PUTD (QUOTE SUBSYS0)
(VIRGINFN (QUOTE SUBSYS)))
(RPAQQ INTERUSERMACROS (EMACS:))
(ADDTOVAR EDITMACROS (EMACS:
NIL
(COMS (CONS (QUOTE COMSQ)
(PROG ((EMACS.RETURN.CASES (QUOTE EMACS:.RETURN)
))
(DUMPX (##))
(RETURN (CAR (NLSETQ (DOWN)))))))))
(/NCONC AFTERSYSOUTFORMS (QUOTE ((FLUSH.EMACS))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PPTI)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1777 39989 (,, 1789 . 1843) (BINARYMODE 1847 . 2164) (
BYTEPOINTER 2168 . 2380) (CF 2384 . 2793) (CFNS 2797 . 2984) (
CHECK.EMACS 2988 . 3051) (CP 3055 . 3582) (CREC 3586 . 4025) (CV 4029 .
4684) (DISPLAY.IN.OTHER.WINDOW 4688 . 4911) (DOWN 4915 . 5030) (DOWN1
5034 . 6874) (DUMP.LINES 6878 . 7923) (DUMP.LINES? 7927 . 8046) (DUMPX
8050 . 8714) (DUMPX1 8718 . 9356) (E! 9360 . 9997) (E. 10001 . 10071) (
E.1 10075 . 11262) (EDIT.DRIBBLE.FILE 11266 . 11918) (EMACS 11922 .
12104) (EMACS.?= 12108 . 12796) (EMACS.EOF.ERROR 12800 . 12873) (
EMACS.EVAL.CURRENT.SEXPR 12877 . 13804) (EMACS.FIND.SEXP 13808 . 14226)
(EMACS.GETDEF 14230 . 16226) (EMACS.P 16230 . 16955) (EMACS.PP 16959 .
18345) (EMACS.REPLACE.SEXP 18349 . 18722) (EMACS.RETURN 18726 . 19580) (
EMACS:.RETURN 19584 . 20411) (ENABLE.CONTROL.C.CAPABILITY 20415 . 20503)
(EMACS.EXE.FILE 20507 . 20658) (FIND.SEXP 20662 . 21085) (FLUSH.EMACS
21089 . 22499) (GET.BYTE 22503 . 22681) (INTER.DIRECTORYNAME 22685 .
22887) (MAKE.QUOTE 22891 . 23129) (MAP.BYTES 23133 . 25512) (MAP.BYTES1
25516 . 25966) (MAP.PROCESS.TO.FILE 25970 . 26556) (PAGE.OF.BYTE 26560 .
26792) (PAGEMODE 26796 . 27251) (PPTI 27255 . 28226) (PUTSTRING 28230 .
28932) (READ.AC 28936 . 29058) (REFRESH 29062 . 29397) (SET.EMACS.VARS
29401 . 29968) (SETUP.FANCY.DRIBBLE 29972 . 31197) (START.EMACS 31201 .
37684) (STIW 37688 . 37786) (SUBSYS1 37790 . 38960) (SUBSYS2 38964 .
39833) (WRITE.RSCAN 39837 . 39986)))))
STOP